mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 05:48:17 +02:00
+ Patch from Joost Van der Sluis to fix transactions
This commit is contained in:
michael
parent
3f15c310d7
commit
951ace9dc2
@ -65,7 +65,7 @@ var i : integer;
|
||||
|
||||
begin
|
||||
for i := 0 to FBRecordCount-1 do FreeRecord(FBBuffers[i]);
|
||||
freemem(FBBuffers);
|
||||
If FBRecordCount > 0 then freemem(FBBuffers);
|
||||
FBRecordcount := 0;
|
||||
FBBuffercount := 0;
|
||||
FBCurrentrecord := -1;
|
||||
|
||||
@ -47,7 +47,7 @@ begin
|
||||
begin
|
||||
If Value then
|
||||
begin
|
||||
if csLoading in ComponentState then
|
||||
if csReading in ComponentState then
|
||||
begin
|
||||
FOpenAfterRead := true;
|
||||
exit;
|
||||
@ -255,6 +255,20 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TDBDataset.SetTransaction (Value : TDBTransaction);
|
||||
|
||||
begin
|
||||
CheckInactive;
|
||||
If Value<>FTransaction then
|
||||
begin
|
||||
If Assigned(FTransaction) then
|
||||
FTransaction.UnregisterDataset(Self);
|
||||
If Value<>Nil Then
|
||||
Value.RegisterDataset(Self);
|
||||
FTransaction:=Value;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TDBDataset.CheckDatabase;
|
||||
|
||||
begin
|
||||
@ -266,13 +280,13 @@ Destructor TDBDataset.Destroy;
|
||||
|
||||
begin
|
||||
Database:=Nil;
|
||||
Transaction:=Nil;
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TDBTransaction
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Procedure TDBTransaction.SetDatabase (Value : TDatabase);
|
||||
|
||||
begin
|
||||
@ -287,6 +301,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TDBTransaction.create(AOwner : TComponent);
|
||||
|
||||
begin
|
||||
inherited create(AOwner);
|
||||
FDatasets:=TList.Create;
|
||||
end;
|
||||
|
||||
Procedure TDBTransaction.CheckDatabase;
|
||||
|
||||
begin
|
||||
@ -294,17 +315,85 @@ begin
|
||||
DatabaseError(SErrNoDatabaseAvailable,Self)
|
||||
end;
|
||||
|
||||
procedure TDBTransaction.CloseDataSets;
|
||||
|
||||
Var I : longint;
|
||||
|
||||
begin
|
||||
If Assigned(FDatasets) then
|
||||
begin
|
||||
For I:=FDatasets.Count-1 downto 0 do
|
||||
TDBDataset(FDatasets[i]).Close;
|
||||
end;
|
||||
end;
|
||||
|
||||
Destructor TDBTransaction.Destroy;
|
||||
|
||||
begin
|
||||
Database:=Nil;
|
||||
RemoveDatasets;
|
||||
FDatasets.Free;
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
procedure TDBTransaction.RemoveDataSets;
|
||||
|
||||
Var I : longint;
|
||||
|
||||
begin
|
||||
If Assigned(FDatasets) then
|
||||
For I:=FDataSets.Count-1 downto 0 do
|
||||
TDBDataset(FDataSets[i]).Transaction:=Nil;
|
||||
end;
|
||||
|
||||
Function TDBTransaction.GetDataSetCount : Longint;
|
||||
|
||||
begin
|
||||
If Assigned(FDatasets) Then
|
||||
Result:=FDatasets.Count
|
||||
else
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
procedure TDBTransaction.UnRegisterDataset (DS : TDBDataset);
|
||||
|
||||
Var I : longint;
|
||||
|
||||
begin
|
||||
I:=FDatasets.IndexOf(DS);
|
||||
If I<>-1 then
|
||||
FDatasets.Delete(I)
|
||||
else
|
||||
DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
|
||||
end;
|
||||
|
||||
procedure TDBTransaction.RegisterDataset (DS : TDBDataset);
|
||||
|
||||
Var I : longint;
|
||||
|
||||
begin
|
||||
I:=FDatasets.IndexOf(DS);
|
||||
If I=-1 then
|
||||
FDatasets.Add(DS)
|
||||
else
|
||||
DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
|
||||
end;
|
||||
|
||||
Function TDBTransaction.GetDataset(Index : longint) : TDBDataset;
|
||||
|
||||
begin
|
||||
If Assigned(FDatasets) then
|
||||
Result:=TDBDataset(FDatasets[Index])
|
||||
else
|
||||
DatabaseError(SNoDatasets);
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2004-09-26 16:55:24 michael
|
||||
Revision 1.7 2004-10-27 07:23:13 michael
|
||||
+ Patch from Joost Van der Sluis to fix transactions
|
||||
|
||||
Revision 1.6 2004/09/26 16:55:24 michael
|
||||
* big patch from Joost van der Sluis
|
||||
bufdataset.inc:
|
||||
fix getrecord (prior)
|
||||
|
||||
@ -625,12 +625,6 @@ begin
|
||||
//!! To be implemented
|
||||
end;
|
||||
|
||||
Procedure TDataset.Loaded;
|
||||
|
||||
begin
|
||||
//!! To be implemented
|
||||
end;
|
||||
|
||||
Procedure TDataset.OpenCursor(InfoQuery: Boolean);
|
||||
|
||||
begin
|
||||
@ -663,12 +657,26 @@ Procedure TDataset.SetActive (Value : Boolean);
|
||||
begin
|
||||
If Value<>Factive then
|
||||
If Value then
|
||||
DoInternalOpen
|
||||
if csLoading in ComponentState then
|
||||
begin
|
||||
FOpenAfterRead := true;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
DoInternalOpen
|
||||
else
|
||||
DoInternalClose(True);
|
||||
FActive:=Value;
|
||||
end;
|
||||
|
||||
procedure TDataset.Loaded;
|
||||
|
||||
begin
|
||||
inherited;
|
||||
if FOpenAfterRead then SetActive(true);
|
||||
end;
|
||||
|
||||
|
||||
procedure TDataSet.RecalcBufListSize;
|
||||
|
||||
var
|
||||
@ -1725,7 +1733,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 2004-10-16 09:27:23 michael
|
||||
Revision 1.27 2004-10-27 07:23:13 michael
|
||||
+ Patch from Joost Van der Sluis to fix transactions
|
||||
|
||||
Revision 1.26 2004/10/16 09:27:23 michael
|
||||
+ Fixed GotoBookMark (as suggested by Americo Luiz)
|
||||
|
||||
Revision 1.25 2004/10/10 14:25:21 michael
|
||||
|
||||
42
fcl/db/db.pp
42
fcl/db/db.pp
@ -67,6 +67,7 @@ type
|
||||
TDataBase = Class;
|
||||
TDatasource = Class;
|
||||
TDatalink = Class;
|
||||
TDBTransaction = Class;
|
||||
|
||||
{ Exception classes }
|
||||
|
||||
@ -773,6 +774,7 @@ type
|
||||
TDataSet = class(TComponent)
|
||||
Private
|
||||
FActive: Boolean;
|
||||
FOpenAfterRead : boolean;
|
||||
FActiveRecord: Longint;
|
||||
FAfterCancel: TDataSetNotifyEvent;
|
||||
FAfterClose: TDataSetNotifyEvent;
|
||||
@ -849,6 +851,7 @@ type
|
||||
procedure CalculateFields(Buffer: PChar); virtual;
|
||||
procedure CheckActive; virtual;
|
||||
procedure CheckInactive; virtual;
|
||||
procedure Loaded; override;
|
||||
procedure ClearBuffers; virtual;
|
||||
procedure ClearCalcFields(Buffer: PChar); virtual;
|
||||
procedure CloseBlob(Field: TField); virtual;
|
||||
@ -896,7 +899,6 @@ type
|
||||
procedure InternalCancel; virtual;
|
||||
procedure InternalEdit; virtual;
|
||||
procedure InternalRefresh; virtual;
|
||||
procedure Loaded; override;
|
||||
procedure OpenCursor(InfoQuery: Boolean); virtual;
|
||||
procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
|
||||
procedure RestoreState(const Value: TDataSetState);
|
||||
@ -1177,36 +1179,45 @@ type
|
||||
property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
|
||||
end;
|
||||
|
||||
|
||||
{ TDBDataset }
|
||||
|
||||
TDBDatasetClass = Class of TDBDataset;
|
||||
TDBDataset = Class(TDataset)
|
||||
Private
|
||||
FDatabase : TDatabase;
|
||||
FTransaction : TDBTransaction;
|
||||
Protected
|
||||
Procedure SetDatabase (Value : TDatabase); virtual;
|
||||
Procedure SetTransaction(Value : TDBTransaction); virtual;
|
||||
Procedure CheckDatabase;
|
||||
Public
|
||||
Destructor destroy; override;
|
||||
Property DataBase : TDatabase Read FDatabase Write SetDatabase;
|
||||
Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
|
||||
end;
|
||||
|
||||
{ TDBTransaction }
|
||||
|
||||
TDBTransactionClass = Class of TDBTransaction;
|
||||
TDBTransaction = Class(TComponent)
|
||||
Private
|
||||
FDatabase : TDatabase;
|
||||
Procedure SetDatabase (Value : TDatabase);
|
||||
Protected
|
||||
Procedure CheckDatabase;
|
||||
Public
|
||||
procedure EndTransaction; virtual; abstract;
|
||||
Destructor destroy; override;
|
||||
Property DataBase : TDatabase Read FDatabase Write SetDatabase;
|
||||
end;
|
||||
|
||||
Private
|
||||
FDatabase : TDatabase;
|
||||
FDataSets : TList;
|
||||
Procedure SetDatabase (Value : TDatabase);
|
||||
Function GetDataSetCount : Longint;
|
||||
Function GetDataset(Index : longint) : TDBDataset;
|
||||
procedure RegisterDataset (DS : TDBDataset);
|
||||
procedure UnRegisterDataset (DS : TDBDataset);
|
||||
procedure RemoveDataSets;
|
||||
Protected
|
||||
Procedure CheckDatabase;
|
||||
procedure EndTransaction; virtual; abstract;
|
||||
Public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
Destructor destroy; override;
|
||||
procedure CloseDataSets;
|
||||
Property DataBase : TDatabase Read FDatabase Write SetDatabase;
|
||||
end;
|
||||
|
||||
{ TDatabase }
|
||||
|
||||
@ -1572,7 +1583,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 2004-10-10 14:45:51 michael
|
||||
Revision 1.27 2004-10-27 07:23:13 michael
|
||||
+ Patch from Joost Van der Sluis to fix transactions
|
||||
|
||||
Revision 1.26 2004/10/10 14:45:51 michael
|
||||
+ Use of dbconst for resource strings
|
||||
|
||||
Revision 1.25 2004/10/10 14:25:21 michael
|
||||
|
||||
@ -32,6 +32,7 @@ Const
|
||||
SErrNoDatabaseAvailable = 'Invalid operation: Not attached to database';
|
||||
SErrNoSelectStatement = 'Cannot open a non-select statement';
|
||||
SErrNoStatement = 'SQL statement not set';
|
||||
SErrTransAlreadyActive = 'Transaction already active';
|
||||
SErrTransactionnSet = 'Transaction not set';
|
||||
SFieldNotFound = 'Field not found : "%s"';
|
||||
SInactiveDataset = 'Operation cannot be performed on an inactive dataset';
|
||||
@ -65,7 +66,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2004-10-16 09:20:25 michael
|
||||
Revision 1.3 2004-10-27 07:23:13 michael
|
||||
+ Patch from Joost Van der Sluis to fix transactions
|
||||
|
||||
Revision 1.2 2004/10/16 09:20:25 michael
|
||||
+ Moved resourcestrings to dbconst
|
||||
|
||||
Revision 1.1 2004/10/10 14:45:51 michael
|
||||
|
||||
@ -69,7 +69,7 @@ type
|
||||
function GetTransactionHandle(trans : TSQLHandle): pointer; override;
|
||||
function Commit(trans : TSQLHandle) : boolean; override;
|
||||
function RollBack(trans : TSQLHandle) : boolean; override;
|
||||
function StartTransaction(trans : TSQLHandle) : boolean; override;
|
||||
function StartdbTransaction(trans : TSQLHandle) : boolean; override;
|
||||
procedure CommitRetaining(trans : TSQLHandle); override;
|
||||
procedure RollBackRetaining(trans : TSQLHandle); override;
|
||||
|
||||
@ -177,7 +177,7 @@ begin
|
||||
else result := true;
|
||||
end;
|
||||
|
||||
function TIBConnection.StartTransaction(trans : TSQLHandle) : boolean;
|
||||
function TIBConnection.StartDBTransaction(trans : TSQLHandle) : boolean;
|
||||
var
|
||||
DBHandle : pointer;
|
||||
tr : TIBTrans;
|
||||
|
||||
@ -56,7 +56,7 @@ Type
|
||||
function GetTransactionHandle(trans : TSQLHandle): pointer; override;
|
||||
function Commit(trans : TSQLHandle) : boolean; override;
|
||||
function RollBack(trans : TSQLHandle) : boolean; override;
|
||||
function StartTransaction(trans : TSQLHandle) : boolean; override;
|
||||
function StartdbTransaction(trans : TSQLHandle) : boolean; override;
|
||||
procedure CommitRetaining(trans : TSQLHandle); override;
|
||||
procedure RollBackRetaining(trans : TSQLHandle); override;
|
||||
Public
|
||||
@ -670,7 +670,7 @@ begin
|
||||
// Do nothing
|
||||
end;
|
||||
|
||||
function TMySQLConnection.StartTransaction(trans: TSQLHandle): boolean;
|
||||
function TMySQLConnection.StartdbTransaction(trans: TSQLHandle): boolean;
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
|
||||
@ -48,7 +48,7 @@ type
|
||||
function RollBack(trans : TSQLHandle) : boolean; override;
|
||||
function Commit(trans : TSQLHandle) : boolean; override;
|
||||
procedure CommitRetaining(trans : TSQLHandle); override;
|
||||
function StartTransaction(trans : TSQLHandle) : boolean; override;
|
||||
function StartdbTransaction(trans : TSQLHandle) : boolean; override;
|
||||
procedure RollBackRetaining(trans : TSQLHandle); override;
|
||||
published
|
||||
property DatabaseName;
|
||||
@ -133,8 +133,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TPQConnection.StartTransaction(trans : TSQLHandle) : boolean;
|
||||
function TPQConnection.StartdbTransaction(trans : TSQLHandle) : boolean;
|
||||
var
|
||||
res : PPGresult;
|
||||
tr : TPQTrans;
|
||||
@ -425,7 +424,6 @@ begin
|
||||
{$R-}
|
||||
with cursor as TPQCursor do for x := 0 to PQnfields(res)-1 do
|
||||
begin
|
||||
// writeln('Getdata:' + pqgetvalue(res,0,x));
|
||||
i := PQfsize(res, x);
|
||||
buffer[0] := chr(pqgetisnull(res,0,x));
|
||||
inc(buffer);
|
||||
|
||||
@ -79,7 +79,7 @@ type
|
||||
function GetTransactionHandle(trans : TSQLHandle): pointer; virtual; abstract;
|
||||
function Commit(trans : TSQLHandle) : boolean; virtual; abstract;
|
||||
function RollBack(trans : TSQLHandle) : boolean; virtual; abstract;
|
||||
function StartTransaction(trans : TSQLHandle) : boolean; virtual; abstract;
|
||||
function StartdbTransaction(trans : TSQLHandle) : boolean; virtual; abstract;
|
||||
procedure CommitRetaining(trans : TSQLHandle); virtual; abstract;
|
||||
procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
|
||||
public
|
||||
@ -112,23 +112,25 @@ type
|
||||
FTrans : TSQLHandle;
|
||||
FAction : TCommitRollbackAction;
|
||||
FActive : boolean;
|
||||
FOpenAfterRead : boolean;
|
||||
|
||||
procedure SetActive(Value : boolean);
|
||||
protected
|
||||
function GetHandle : Pointer; virtual;
|
||||
procedure Loaded; override;
|
||||
public
|
||||
procedure EndTransaction; override;
|
||||
procedure Commit; virtual;
|
||||
procedure CommitRetaining; virtual;
|
||||
procedure Rollback; virtual;
|
||||
procedure RollbackRetaining; virtual;
|
||||
procedure StartTransaction;
|
||||
procedure StartTransaction; virtual;
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property Handle: Pointer read GetHandle;
|
||||
procedure EndTransaction; override;
|
||||
published
|
||||
property Action : TCommitRollbackAction read FAction write FAction;
|
||||
property Active : boolean read FActive write SetActive;
|
||||
property Active : boolean read FActive write setactive;
|
||||
property Database;
|
||||
end;
|
||||
|
||||
@ -138,13 +140,11 @@ type
|
||||
private
|
||||
FCursor : TSQLHandle;
|
||||
FOpen : Boolean;
|
||||
FTransaction : TSQLTransaction;
|
||||
FSQL : TStrings;
|
||||
FIsEOF : boolean;
|
||||
FLoadingFieldDefs : boolean;
|
||||
FRecordSize : Integer;
|
||||
|
||||
procedure SetTransaction(Value : TSQLTransaction);
|
||||
procedure FreeStatement;
|
||||
procedure PrepareStatement;
|
||||
procedure FreeFldBuffers;
|
||||
@ -209,7 +209,7 @@ type
|
||||
property AutoCalcFields;
|
||||
property Database;
|
||||
|
||||
property Transaction : TSQLTransaction read FTransaction write SetTransaction;
|
||||
property Transaction;
|
||||
property SQL : TStrings read FSQL write FSQL;
|
||||
end;
|
||||
|
||||
@ -241,8 +241,9 @@ end;
|
||||
|
||||
procedure TSQLConnection.DoInternalConnect;
|
||||
begin
|
||||
if Connected then
|
||||
Close;
|
||||
// Where is this for?!?!
|
||||
// if Connected then
|
||||
// Close;
|
||||
end;
|
||||
|
||||
procedure TSQLConnection.DoInternalDisconnect;
|
||||
@ -251,11 +252,6 @@ end;
|
||||
|
||||
destructor TSQLConnection.Destroy;
|
||||
begin
|
||||
if FTransaction <> nil then
|
||||
begin
|
||||
FTransaction.Active := False;
|
||||
FTransaction.Database := nil;
|
||||
end;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -283,9 +279,28 @@ end;
|
||||
procedure TSQLTransaction.SetActive(Value : boolean);
|
||||
begin
|
||||
if FActive and (not Value) then
|
||||
Rollback
|
||||
EndTransaction
|
||||
else if (not FActive) and Value then
|
||||
StartTransaction;
|
||||
if csLoading in ComponentState then
|
||||
begin
|
||||
FOpenAfterRead := true;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
StartTransaction;
|
||||
end;
|
||||
|
||||
procedure TSQLTransaction.Loaded;
|
||||
|
||||
begin
|
||||
inherited;
|
||||
if FOpenAfterRead then SetActive(true);
|
||||
end;
|
||||
|
||||
procedure TSQLTransaction.EndTransaction;
|
||||
|
||||
begin
|
||||
rollback;
|
||||
end;
|
||||
|
||||
function TSQLTransaction.GetHandle: pointer;
|
||||
@ -296,8 +311,12 @@ end;
|
||||
procedure TSQLTransaction.Commit;
|
||||
begin
|
||||
if not FActive then Exit;
|
||||
if (Database as tsqlconnection).commit(FTrans) then FActive := false;
|
||||
FTrans.free;
|
||||
closedatasets;
|
||||
if (Database as tsqlconnection).commit(FTrans) then
|
||||
begin
|
||||
FActive := false;
|
||||
FTrans.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLTransaction.CommitRetaining;
|
||||
@ -309,13 +328,12 @@ end;
|
||||
procedure TSQLTransaction.Rollback;
|
||||
begin
|
||||
if not FActive then Exit;
|
||||
if (Database as tsqlconnection).RollBack(FTrans) then FActive := false;
|
||||
FTrans.free;
|
||||
end;
|
||||
|
||||
procedure TSQLTransaction.EndTransaction;
|
||||
begin
|
||||
Rollback;
|
||||
closedatasets;
|
||||
if (Database as tsqlconnection).RollBack(FTrans) then
|
||||
begin
|
||||
FActive := false;
|
||||
FTrans.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLTransaction.RollbackRetaining;
|
||||
@ -329,7 +347,8 @@ procedure TSQLTransaction.StartTransaction;
|
||||
var db : TSQLConnection;
|
||||
|
||||
begin
|
||||
if Active then Active := False;
|
||||
if Active then
|
||||
DatabaseError(SErrTransAlreadyActive);
|
||||
|
||||
db := (Database as tsqlconnection);
|
||||
|
||||
@ -340,7 +359,7 @@ begin
|
||||
Db.Open;
|
||||
if not assigned(FTrans) then FTrans := Db.AllocateTransactionHandle;
|
||||
|
||||
if Db.StartTransaction(FTrans) then FActive := true;
|
||||
if Db.StartdbTransaction(FTrans) then FActive := true;
|
||||
end;
|
||||
|
||||
constructor TSQLTransaction.Create(AOwner : TComponent);
|
||||
@ -350,23 +369,11 @@ end;
|
||||
|
||||
destructor TSQLTransaction.Destroy;
|
||||
begin
|
||||
// This will also do a Rollback, if the transaction is currently active
|
||||
Active := False;
|
||||
|
||||
// Database.Transaction := nil;
|
||||
|
||||
Rollback;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TSQLQuery }
|
||||
|
||||
procedure TSQLQuery.SetTransaction(Value : TSQLTransaction);
|
||||
begin
|
||||
CheckInactive;
|
||||
if (FTransaction <> Value) then
|
||||
FTransaction := Value;
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.SetDatabase(Value : TDatabase);
|
||||
|
||||
var db : tsqlconnection;
|
||||
@ -376,32 +383,37 @@ begin
|
||||
begin
|
||||
db := value as tsqlconnection;
|
||||
inherited setdatabase(value);
|
||||
if (FTransaction = nil) and (Assigned(Db.Transaction)) then
|
||||
SetTransaction(Db.Transaction);
|
||||
if assigned(value) and (Transaction = nil) and (Assigned(db.Transaction)) then
|
||||
transaction := Db.Transaction;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.FreeStatement;
|
||||
begin
|
||||
(Database as tsqlconnection).FreeStatement(FCursor);
|
||||
if assigned(FCursor) then
|
||||
begin
|
||||
(Database as tsqlconnection).FreeStatement(FCursor);
|
||||
FCursor.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.PrepareStatement;
|
||||
var
|
||||
Buf : string;
|
||||
x : integer;
|
||||
db : tsqlconnection;
|
||||
Buf : string;
|
||||
x : integer;
|
||||
db : tsqlconnection;
|
||||
sqltr : tsqltransaction;
|
||||
begin
|
||||
db := (Database as tsqlconnection);
|
||||
if Db = nil then
|
||||
DatabaseError(SErrDatabasenAssigned);
|
||||
if not Db.Connected then
|
||||
db.Open;
|
||||
if FTransaction = nil then
|
||||
if Transaction = nil then
|
||||
DatabaseError(SErrTransactionnSet);
|
||||
|
||||
if not FTransaction.Active then
|
||||
FTransaction.StartTransaction;
|
||||
|
||||
sqltr := (transaction as tsqltransaction);
|
||||
if not sqltr.Active then sqltr.StartTransaction;
|
||||
|
||||
if assigned(fcursor) then FCursor.free;
|
||||
FCursor := Db.AllocateCursorHandle;
|
||||
@ -414,15 +426,13 @@ begin
|
||||
DatabaseError(SErrNoStatement);
|
||||
exit;
|
||||
end;
|
||||
|
||||
FCursor.StatementType := GetSQLStatementType(buf);
|
||||
|
||||
Db.PrepareStatement(Fcursor,FTransaction,buf);
|
||||
Db.PrepareStatement(Fcursor,sqltr,buf);
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.FreeFldBuffers;
|
||||
begin
|
||||
(Database as tsqlconnection).FreeFldBuffers(FCursor);
|
||||
if assigned(FCursor) then (Database as tsqlconnection).FreeFldBuffers(FCursor);
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.Fetch;
|
||||
@ -452,7 +462,7 @@ end;
|
||||
|
||||
procedure TSQLQuery.Execute;
|
||||
begin
|
||||
(Database as tsqlconnection).execute(Fcursor,FTransaction);
|
||||
(Database as tsqlconnection).execute(Fcursor,Transaction as tsqltransaction);
|
||||
end;
|
||||
|
||||
function TSQLQuery.AllocRecord(ExtraSize : integer): PChar;
|
||||
@ -493,7 +503,6 @@ begin
|
||||
FIsEOF := False;
|
||||
FRecordSize := 0;
|
||||
FOpen:=False;
|
||||
FCursor.free;
|
||||
inherited internalclose;
|
||||
end;
|
||||
|
||||
@ -649,7 +658,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2004-10-10 14:45:52 michael
|
||||
Revision 1.6 2004-10-27 07:23:13 michael
|
||||
+ Patch from Joost Van der Sluis to fix transactions
|
||||
|
||||
Revision 1.5 2004/10/10 14:45:52 michael
|
||||
+ Use of dbconst for resource strings
|
||||
|
||||
Revision 1.4 2004/10/10 14:24:22 michael
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/09/04]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/07/12]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom morphos netwlibc
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom morphos
|
||||
BSDs = freebsd netbsd openbsd darwin
|
||||
UNIXs = linux $(BSDs) sunos qnx
|
||||
FORCE:
|
||||
@ -214,7 +214,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
|
||||
endif
|
||||
PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
|
||||
override PACKAGE_NAME=fcl
|
||||
override TARGET_UNITS+=sqlitedataset
|
||||
override TARGET_UNITS+=sqliteds
|
||||
override INSTALL_FPCPACKAGE=y
|
||||
override COMPILER_TARGETDIR+=../../$(OS_TARGET)
|
||||
ifdef REQUIRE_UNITSDIR
|
||||
@ -525,12 +525,6 @@ STATICLIBPREFIX=
|
||||
FPCMADE=fpcmade.nw
|
||||
ZIPSUFFIX=nw
|
||||
endif
|
||||
ifeq ($(OS_TARGET),netwlibc)
|
||||
EXEEXT=.nlm
|
||||
STATICLIBPREFIX=
|
||||
FPCMADE=fpcmade.nwl
|
||||
ZIPSUFFIX=nwl
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macos)
|
||||
BATCHEXT=
|
||||
EXEEXT=
|
||||
@ -683,18 +677,6 @@ FPCMADE=fpcmade.nw
|
||||
ZIPSUFFIX=nw
|
||||
EXEEXT=.nlm
|
||||
endif
|
||||
ifeq ($(OS_TARGET),netwlibc)
|
||||
STATICLIBPREFIX=
|
||||
PPUEXT=.ppu
|
||||
OEXT=.o
|
||||
ASMEXT=.s
|
||||
SMARTEXT=.sl
|
||||
STATICLIBEXT=.a
|
||||
SHAREDLIBEXT=.nlm
|
||||
FPCMADE=fpcmade.nwl
|
||||
ZIPSUFFIX=nwl
|
||||
EXEEXT=.nlm
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macos)
|
||||
BATCHEXT=
|
||||
PPUEXT=.ppu
|
||||
@ -1129,12 +1111,6 @@ REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_SQLITE=1
|
||||
endif
|
||||
endif
|
||||
ifeq ($(OS_TARGET),netwlibc)
|
||||
ifeq ($(CPU_TARGET),i386)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_SQLITE=1
|
||||
endif
|
||||
endif
|
||||
ifdef REQUIRE_PACKAGES_RTL
|
||||
PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR))))))
|
||||
ifneq ($(PACKAGEDIR_RTL),)
|
||||
@ -1339,7 +1315,7 @@ fpc_debug:
|
||||
$(MAKE) all DEBUG=1
|
||||
fpc_release:
|
||||
$(MAKE) all RELEASE=1
|
||||
.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
|
||||
.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .dpr .pp .rc .res
|
||||
%$(PPUEXT): %.pp
|
||||
$(COMPILER) $<
|
||||
$(EXECPPAS)
|
||||
@ -1352,9 +1328,6 @@ fpc_release:
|
||||
%$(EXEEXT): %.pas
|
||||
$(COMPILER) $<
|
||||
$(EXECPPAS)
|
||||
%$(EXEEXT): %.lpr
|
||||
$(COMPILER) $<
|
||||
$(EXECPPAS)
|
||||
%$(EXEEXT): %.dpr
|
||||
$(COMPILER) $<
|
||||
$(EXECPPAS)
|
||||
@ -1362,7 +1335,6 @@ fpc_release:
|
||||
windres -i $< -o $@
|
||||
vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
|
||||
vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
|
||||
vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
|
||||
vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
|
||||
vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
|
||||
.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
main=fcl
|
||||
|
||||
[target]
|
||||
units=sqlitedataset
|
||||
units=sqliteds
|
||||
|
||||
[require]
|
||||
packages=sqlite
|
||||
|
||||
Loading…
Reference in New Issue
Block a user