paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 10:29:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

-some filter fixes

Browse Source 
- added ParseSQL property
- added DeAllocateCursorHandle
- fixed tibconnection string-parameters

git-svn-id: trunk@620 -
This commit is contained in:
joost 2005-07-13 21:03:53 +00:00
parent 6ed53e2c70
commit 62871eddeb
4 changed files with 89 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
fcl/db/sqldb/interbase/ibconnection.pp
View File

@ -67,6 +67,7 @@ type
function GetHandle : pointer; override;
Function AllocateCursorHandle : TSQLCursor; override;
Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
Function AllocateTransactionHandle : TSQLHandle; override;
procedure CloseStatement(cursor : TSQLCursor); override;
@ -410,6 +411,17 @@ begin
result := curs;
end;
procedure TIBConnection.DeAllocateCursorHandle(var cursor : TSQLCursor);
begin
if assigned(cursor) then with cursor as TIBCursor do
begin
reAllocMem(SQLDA,0);
reAllocMem(in_SQLDA,0);
end;
FreeAndNil(cursor);
end;
Function TIBConnection.AllocateTransactionHandle : TSQLHandle;
begin
@ -424,8 +436,6 @@ begin
CheckError('FreeStatement', Status);
Statement := nil;
end;
// reAllocMem((cursor as tibcursor).SQLDA,0);
// ^=bug moet nog ergens anders komen...
end;
procedure TIBConnection.PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams);
@ -585,6 +595,7 @@ var ParNr,SQLVarNr : integer;
s : string;
i : integer;
currbuff : pchar;
w : word;
begin
{$R-}
@ -607,7 +618,17 @@ begin
begin
{$R-}
s := AParams[ParNr].AsString;
Move(s[1], in_sqlda^.SQLvar[SQLVarNr].SQLData^, length(s));
w := length(s);
if ((in_sqlda^.SQLvar[SQLVarNr].SQLType and not 1) = SQL_VARYING) then
begin
in_sqlda^.SQLvar[SQLVarNr].SQLLen := w;
in_sqlda^.SQLvar[SQLVarNr].SQLData := AllocMem(in_SQLDA^.SQLVar[SQLVarNr].SQLLen+2)
end;
CurrBuff := in_sqlda^.SQLvar[SQLVarNr].SQLData;
move(w,CurrBuff^,sizeof(w));
inc(CurrBuff,2);
Move(s[1], CurrBuff^, length(s));
{$R+}
end;
else

7
fcl/db/sqldb/mysql/mysql4conn.pas
View File

@ -51,6 +51,7 @@ Type
function GetHandle : pointer; override;
Function AllocateCursorHandle : TSQLCursor; override;
Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
Function AllocateTransactionHandle : TSQLHandle; override;
procedure CloseStatement(cursor : TSQLCursor); override;
@ -206,6 +207,12 @@ begin
Result:=TMySQLCursor.Create;
end;
Procedure TMySQLConnection.DeAllocateCursorHandle(var cursor : TSQLCursor);
begin
FreeAndNil(cursor);
end;
function TMySQLConnection.AllocateTransactionHandle: TSQLHandle;
begin
Result:=TMySQLTransaction.Create;

7
fcl/db/sqldb/postgres/pqconnection.pp
View File

@ -42,6 +42,7 @@ type
function GetHandle : pointer; override;
Function AllocateCursorHandle : TSQLCursor; override;
Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
Function AllocateTransactionHandle : TSQLHandle; override;
procedure CloseStatement(cursor : TSQLCursor); override;
@ -319,6 +320,12 @@ begin
result := TPQCursor.create;
end;
Procedure TPQConnection.DeAllocateCursorHandle(var cursor : TSQLCursor);
begin
FreeAndNil(cursor);
end;
Function TPQConnection.AllocateTransactionHandle : TSQLHandle;
begin

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

@ -76,6 +76,7 @@ type
function GetHandle : pointer; virtual; abstract;
Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
Function AllocateTransactionHandle : TSQLHandle; virtual; abstract;
procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); virtual; abstract;
@ -163,6 +164,7 @@ type
FFromPart : String;
FWhereStartPos : integer;
FWhereStopPos : integer;
FParseSQL : boolean;
// FSchemaInfo : TSchemaInfo;
procedure CloseStatement;
@ -172,12 +174,14 @@ type
function GetStatementType : TStatementType;
procedure SetIndexDefs(AValue : TIndexDefs);
procedure SetReadOnly(AValue : Boolean);
procedure SetParseSQL(AValue : Boolean);
procedure SetUsePrimaryKeyAsKey(AValue : Boolean);
procedure SetUpdateMode(AValue : TUpdateMode);
procedure OnChangeSQL(Sender : TObject);
procedure Execute;
Procedure ParseSQL(var SQL : string);
Procedure SQLParser(var SQL : string);
Function AddFilter(SQLstr : string) : string;
protected
// abstract & virtual methods of TBufDataset
function Fetch : boolean; override;
@ -194,10 +198,8 @@ type
function GetCanModify: Boolean; override;
function ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean; override;
Function IsPrepared : Boolean; virtual;
function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override;
procedure SetFiltered(Value: Boolean); override;
procedure SetFilterText(const Value: string); override;
public
procedure Prepare; virtual;
procedure UnPrepare; virtual;
@ -246,6 +248,7 @@ type
property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode;
property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey;
property StatementType : TStatementType read GetStatementType;
property ParseSQL : Boolean read FParseSQL write SetParseSQL;
// property SchemaInfo : TSchemaInfo read FSchemaInfo default stNoSchema;
end;
@ -526,25 +529,22 @@ begin
Result := Assigned(FCursor) and FCursor.FPrepared;
end;
function TSQLQuery.GetFieldData(Field: TField; Buffer: Pointer;
NativeFormat: Boolean): Boolean;
begin
Result:=GetFieldData(Field, Buffer);
end;
procedure TSQLQuery.SetFieldData(Field: TField; Buffer: Pointer;
NativeFormat: Boolean);
begin
SetFieldData(Field, Buffer);
end;
procedure TSQLQuery.SetFilterText(const Value: string);
Function TSQLQuery.AddFilter(SQLstr : string) : string;
begin
if Filtered then
begin
end;
Inherited SetFilterText(Value);
if FWhereStartPos = 0 then
SQLstr := SQLstr + ' where (' + Filter + ')'
else if FWhereStopPos > 0 then
system.insert(' and ('+Filter+') ',SQLstr,FWhereStopPos+1)
else
system.insert(' where ('+Filter+') ',SQLstr,FWhereStartPos);
Result := SQLstr;
end;
procedure TSQLQuery.SetFiltered(Value: Boolean);
@ -552,6 +552,7 @@ procedure TSQLQuery.SetFiltered(Value: Boolean);
var S : String;
begin
if Value and not FParseSQL then DatabaseErrorFmt(SNoParseSQL,['Filtering ']);
if (Filtered <> Value) and Active then
begin
CloseStatement;
@ -560,25 +561,15 @@ begin
s := FSQLBuf;
if Value then
begin
if FWhereStartPos = 0 then
s := s + ' where (' + Filter + ')'
else if FWhereStopPos > 0 then
system.insert(' and ('+Filter+') ',S,FWhereStopPos+1)
else
system.insert(' where ('+Filter+') ',S,FWhereStartPos);
end;
if Value then s := AddFilter(s);
(Database as tsqlconnection).PrepareStatement(Fcursor,(transaction as tsqltransaction),S,FParams);
Execute;
inherited InternalOpen;
First;
inherited SetFiltered(Value);
end;
inherited setfiltered(Value);
end;
procedure TSQLQuery.Prepare;
@ -604,9 +595,12 @@ begin
FSQLBuf := TrimRight(FSQL.Text);
ParseSQL(FSQLBuf);
SQLParser(FSQLBuf);
Db.PrepareStatement(Fcursor,sqltr,FSQLBuf,FParams);
if filtered then
Db.PrepareStatement(Fcursor,sqltr,AddFilter(FSQLBuf),FParams)
else
Db.PrepareStatement(Fcursor,sqltr,FSQLBuf,FParams);
if (FCursor.FStatementType = stSelect) and not ReadOnly then
InitUpdates(FSQLBuf);
@ -617,8 +611,11 @@ procedure TSQLQuery.UnPrepare;
begin
CheckInactive;
if IsPrepared then (Database as tsqlconnection).UnPrepareStatement(FCursor);
FreeAndNil(FCursor);
if IsPrepared then with Database as TSQLConnection do
begin
UnPrepareStatement(FCursor);
DeAllocateCursorHandle(FCursor);
end;
end;
procedure TSQLQuery.FreeFldBuffers;
@ -682,7 +679,7 @@ begin
end;
end;
procedure TSQLQuery.ParseSQL(var SQL : string);
procedure TSQLQuery.SQLParser(var SQL : string);
type TParsePart = (ppStart,ppSelect,ppWhere,ppFrom,ppOrder,ppComment,ppBogus);
@ -721,6 +718,7 @@ begin
FCursor.FStatementType := (Database as tsqlconnection).StrToStatementType(s);
if FCursor.FStatementType = stSelect then ParsePart := ppSelect
else break;
if not FParseSQL then break;
PStatementPart := CurrentP;
end;
ppSelect : begin
@ -858,6 +856,7 @@ begin
FSQL.OnChange := @OnChangeSQL;
FIndexDefs := TIndexDefs.Create(Self);
FReadOnly := false;
FParseSQL := True;
// Delphi has upWhereAll as default, but since strings and oldvalue's don't work yet
// (variants) set it to upWhereKeyOnly
FUpdateMode := upWhereKeyOnly;
@ -877,12 +876,27 @@ end;
procedure TSQLQuery.SetReadOnly(AValue : Boolean);
begin
if not Active then FReadOnly := AValue
else
CheckInactive;
if not AValue then
begin
// Just temporary, this should be possible in the future
DatabaseError(SActiveDataset);
end;
if FParseSQL then FReadOnly := False
else DatabaseErrorFmt(SNoParseSQL,['Updating ']);
end
else FReadOnly := True;
end;
procedure TSQLQuery.SetParseSQL(AValue : Boolean);
begin
CheckInactive;
if not AValue then
begin
FReadOnly := True;
Filtered := False;
FParseSQL := False;
end
else
FParseSQL := True;
end;
procedure TSQLQuery.SetUsePrimaryKeyAsKey(AValue : Boolean);