mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-20 00:02:55 +02:00
- implemented TSQLQuery.SetSchemaInfo
- added support for delete and insert
This commit is contained in:
parent
e5c50c40ee
commit
e2d68a7e4f
@ -24,6 +24,8 @@ interface
|
|||||||
|
|
||||||
uses SysUtils, Classes, DB;
|
uses SysUtils, Classes, DB;
|
||||||
|
|
||||||
|
type TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages);
|
||||||
|
|
||||||
type
|
type
|
||||||
TSQLConnection = class;
|
TSQLConnection = class;
|
||||||
TSQLTransaction = class;
|
TSQLTransaction = class;
|
||||||
@ -83,9 +85,10 @@ type
|
|||||||
procedure CommitRetaining(trans : TSQLHandle); virtual; abstract;
|
procedure CommitRetaining(trans : TSQLHandle); virtual; abstract;
|
||||||
procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
|
procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
|
||||||
procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual;
|
procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual;
|
||||||
|
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
|
||||||
public
|
public
|
||||||
destructor Destroy; override;
|
|
||||||
property Handle: Pointer read GetHandle;
|
property Handle: Pointer read GetHandle;
|
||||||
|
destructor Destroy; override;
|
||||||
published
|
published
|
||||||
property Password : string read FPassword write FPassword;
|
property Password : string read FPassword write FPassword;
|
||||||
property Transaction : TSQLTransaction read FTransaction write SetTransaction;
|
property Transaction : TSQLTransaction read FTransaction write SetTransaction;
|
||||||
@ -142,6 +145,7 @@ type
|
|||||||
FReadOnly : boolean;
|
FReadOnly : boolean;
|
||||||
FUpdateMode : TUpdateMode;
|
FUpdateMode : TUpdateMode;
|
||||||
FusePrimaryKeyAsKey : Boolean;
|
FusePrimaryKeyAsKey : Boolean;
|
||||||
|
// FSchemaInfo : TSchemaInfo;
|
||||||
|
|
||||||
procedure FreeStatement;
|
procedure FreeStatement;
|
||||||
procedure PrepareStatement;
|
procedure PrepareStatement;
|
||||||
@ -164,17 +168,17 @@ type
|
|||||||
procedure SetDatabase(Value : TDatabase); override;
|
procedure SetDatabase(Value : TDatabase); override;
|
||||||
procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override;
|
procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override;
|
||||||
procedure InternalClose; override;
|
procedure InternalClose; override;
|
||||||
procedure InternalDelete; override;
|
|
||||||
procedure InternalHandleException; override;
|
procedure InternalHandleException; override;
|
||||||
procedure InternalInitFieldDefs; override;
|
procedure InternalInitFieldDefs; override;
|
||||||
procedure InternalOpen; override;
|
procedure InternalOpen; override;
|
||||||
function GetCanModify: Boolean; override;
|
function GetCanModify: Boolean; override;
|
||||||
Function GetSQLStatementType(SQL : String) : TStatementType; virtual;
|
Function GetSQLStatementType(SQL : String) : TStatementType; virtual;
|
||||||
function ApplyRecUpdate : boolean; override;
|
function ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean; override;
|
||||||
public
|
public
|
||||||
procedure ExecSQL; virtual;
|
procedure ExecSQL; virtual;
|
||||||
constructor Create(AOwner : TComponent); override;
|
constructor Create(AOwner : TComponent); override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
procedure SetSchemaInfo( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string); virtual;
|
||||||
published
|
published
|
||||||
// redeclared data set properties
|
// redeclared data set properties
|
||||||
property Active;
|
property Active;
|
||||||
@ -212,6 +216,7 @@ type
|
|||||||
property IndexDefs : TIndexDefs read GetIndexDefs;
|
property IndexDefs : TIndexDefs read GetIndexDefs;
|
||||||
property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode;
|
property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode;
|
||||||
property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey;
|
property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey;
|
||||||
|
// property SchemaInfo : TSchemaInfo read FSchemaInfo default stNoSchema;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -285,6 +290,13 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TSQLConnection.GetSchemaInfoSQL( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DatabaseError(SMetadataUnavailable);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TSQLTransaction }
|
{ TSQLTransaction }
|
||||||
procedure TSQLTransaction.EndTransaction;
|
procedure TSQLTransaction.EndTransaction;
|
||||||
|
|
||||||
@ -467,11 +479,6 @@ begin
|
|||||||
inherited internalclose;
|
inherited internalclose;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TSQLQuery.InternalDelete;
|
|
||||||
begin
|
|
||||||
// not implemented - sql dataset
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSQLQuery.InternalHandleException;
|
procedure TSQLQuery.InternalHandleException;
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
@ -703,10 +710,6 @@ begin
|
|||||||
Setlength(S,PE-P);
|
Setlength(S,PE-P);
|
||||||
Move(P^,S[1],(PE-P));
|
Move(P^,S[1],(PE-P));
|
||||||
result := (DataBase as TSQLConnection).StrToStatementType(s);
|
result := (DataBase as TSQLConnection).StrToStatementType(s);
|
||||||
{ S:=Lowercase(s);
|
|
||||||
For t:=stselect to strollback do
|
|
||||||
if (S=StatementTokens[t]) then
|
|
||||||
Exit(t);}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TSQLQuery.SetReadOnly(AValue : Boolean);
|
procedure TSQLQuery.SetReadOnly(AValue : Boolean);
|
||||||
@ -738,49 +741,105 @@ begin
|
|||||||
(DataBase as TSQLConnection).UpdateIndexDefs(FIndexDefs,FTableName);
|
(DataBase as TSQLConnection).UpdateIndexDefs(FIndexDefs,FTableName);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TSQLQuery.ApplyRecUpdate : boolean;
|
function TSQLQuery.ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean;
|
||||||
|
|
||||||
var r,x,f : integer;
|
var
|
||||||
fieldsstr,
|
|
||||||
v : string;
|
|
||||||
modify_query : tsqlquery;
|
|
||||||
sql_tables : string;
|
sql_tables : string;
|
||||||
sql_set : string;
|
|
||||||
sql_where : string;
|
|
||||||
s : string;
|
s : string;
|
||||||
|
|
||||||
begin
|
procedure UpdateWherePart(var sql_where : string;x : integer);
|
||||||
Result := False;
|
|
||||||
sql_tables := FTableName;
|
begin
|
||||||
sql_set := '';
|
|
||||||
sql_where := '';
|
|
||||||
for x := 0 to Fields.Count -1 do
|
|
||||||
begin
|
|
||||||
if (pfInKey in Fields[x].ProviderFlags) or
|
if (pfInKey in Fields[x].ProviderFlags) or
|
||||||
((FUpdateMode = upWhereAll) and (pfInWhere in Fields[x].ProviderFlags)) or
|
((FUpdateMode = upWhereAll) and (pfInWhere in Fields[x].ProviderFlags)) or
|
||||||
((FUpdateMode = UpWhereChanged) and (pfInWhere in Fields[x].ProviderFlags) and (fields[x].value <> fields[x].oldvalue)) then
|
((FUpdateMode = UpWhereChanged) and (pfInWhere in Fields[x].ProviderFlags) and (fields[x].value <> fields[x].oldvalue)) then
|
||||||
begin
|
begin
|
||||||
// This should be converted to something like GetAsSQLText, but better wait until variants (oldvalue) are working for strings
|
// This should be converted to something like GetAsSQLText, but better wait until variants (oldvalue) are working for strings
|
||||||
s := fields[x].oldvalue; // This directly int the line below raises a variant-error
|
s := fields[x].oldvalue; // This directly int the line below raises a variant-error
|
||||||
sql_where := sql_where + '(' + fields[x].DisplayName + '=' + s + ') and ';
|
sql_where := sql_where + '(' + fields[x].FieldName + '=' + s + ') and ';
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
if (pfInUpdate in Fields[x].ProviderFlags) then
|
|
||||||
if ord(ActiveBuffer[(Fields[x].Fieldno-1) div 8]) and (1 shl ((Fields[x].Fieldno-1) mod 8)) > 0 then // check for null
|
|
||||||
sql_set := sql_set + fields[x].DisplayName + '=' + (Database as TSQLConnection).GetAsSQLText(nil) + ','
|
|
||||||
else
|
|
||||||
sql_set := sql_set + fields[x].DisplayName + '=' + (Database as TSQLConnection).GetAsSQLText(fields[x]) + ',';
|
|
||||||
end;
|
|
||||||
|
|
||||||
setlength(sql_set,length(sql_set)-1);
|
function ModifyRecQuery : string;
|
||||||
setlength(sql_where,length(sql_where)-5);
|
|
||||||
|
|
||||||
|
var x : integer;
|
||||||
|
sql_set : string;
|
||||||
|
sql_where : string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
sql_tables := FTableName;
|
||||||
|
sql_set := '';
|
||||||
|
sql_where := '';
|
||||||
|
for x := 0 to Fields.Count -1 do
|
||||||
|
begin
|
||||||
|
UpdateWherePart(sql_where,x);
|
||||||
|
|
||||||
|
if (pfInUpdate in Fields[x].ProviderFlags) then
|
||||||
|
if fields[x].IsNull then // check for null
|
||||||
|
sql_set := sql_set + fields[x].FieldName + '=' + (Database as TSQLConnection).GetAsSQLText(nil) + ','
|
||||||
|
else
|
||||||
|
sql_set := sql_set + fields[x].FieldName + '=' + (Database as TSQLConnection).GetAsSQLText(fields[x]) + ',';
|
||||||
|
end;
|
||||||
|
|
||||||
|
setlength(sql_set,length(sql_set)-1);
|
||||||
|
setlength(sql_where,length(sql_where)-5);
|
||||||
|
result := 'update ' + sql_tables + ' set ' + sql_set + ' where ' + sql_where;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
function InsertRecQuery : string;
|
||||||
|
|
||||||
|
var x : integer;
|
||||||
|
sql_fields : string;
|
||||||
|
sql_values : string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
sql_tables := FTableName;
|
||||||
|
sql_fields := '';
|
||||||
|
sql_values := '';
|
||||||
|
for x := 0 to Fields.Count -1 do
|
||||||
|
begin
|
||||||
|
if not fields[x].IsNull then
|
||||||
|
begin
|
||||||
|
sql_fields := sql_fields + fields[x].DisplayName + ',';
|
||||||
|
sql_values := sql_values + (Database as TSQLConnection).GetAsSQLText(fields[x]) + ',';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
setlength(sql_fields,length(sql_fields)-1);
|
||||||
|
setlength(sql_values,length(sql_values)-1);
|
||||||
|
|
||||||
|
result := 'insert into ' + sql_tables + ' (' + sql_fields + ') values (' + sql_values + ')';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DeleteRecQuery : string;
|
||||||
|
|
||||||
|
var x : integer;
|
||||||
|
sql_where : string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
sql_tables := FTableName;
|
||||||
|
|
||||||
|
sql_where := '';
|
||||||
|
for x := 0 to Fields.Count -1 do
|
||||||
|
UpdateWherePart(sql_where,x);
|
||||||
|
|
||||||
|
setlength(sql_where,length(sql_where)-5);
|
||||||
|
|
||||||
|
result := 'delete from ' + sql_tables + ' where ' + sql_where;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
with tsqlquery.Create(nil) do
|
with tsqlquery.Create(nil) do
|
||||||
begin
|
begin
|
||||||
DataBase := self.Database;
|
DataBase := self.Database;
|
||||||
transaction := self.transaction;
|
transaction := self.transaction;
|
||||||
sql.clear;
|
sql.clear;
|
||||||
s := 'update ' + sql_tables + ' set ' + sql_set + ' where ' + sql_where;
|
case UpdateKind of
|
||||||
|
ukModify : s := ModifyRecQuery;
|
||||||
|
ukInsert : s := InsertRecQuery;
|
||||||
|
ukDelete : s := DeleteRecQuery;
|
||||||
|
end; {case}
|
||||||
sql.add(s);
|
sql.add(s);
|
||||||
ExecSQL;
|
ExecSQL;
|
||||||
Result := true;
|
Result := true;
|
||||||
@ -816,11 +875,23 @@ begin
|
|||||||
FUpdateMode := AValue;
|
FUpdateMode := AValue;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TSQLQuery.SetSchemaInfo( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string);
|
||||||
|
|
||||||
|
begin
|
||||||
|
SQL.Clear;
|
||||||
|
SQL.Add((DataBase as tsqlconnection).GetSchemaInfoSQL(SchemaType, SchemaObjectName, SchemaPattern));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.12 2005-01-24 10:52:43 michael
|
Revision 1.13 2005-02-07 11:23:41 joost
|
||||||
|
- implemented TSQLQuery.SetSchemaInfo
|
||||||
|
- added support for delete and insert
|
||||||
|
|
||||||
|
Revision 1.12 2005/01/24 10:52:43 michael
|
||||||
* Patch from Joost van der Sluis
|
* Patch from Joost van der Sluis
|
||||||
- Made it possible to run 'show' queries for MySQL
|
- Made it possible to run 'show' queries for MySQL
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user