Browse Source

* big patch from Joost van der Sluis
bufdataset.inc:
fix getrecord (prior)
getcanmodify default false
database.inc / db.inc:
Added transactions
dataset.inc:
raise error if trying to insert into an readonly dataset
db.inc:
remove published properties from bufdataset
changed ancestor of tbufdataset to tdbdataset

michael 21 years ago
parent
commit
fc9989eb80
5 changed files with 201 additions and 39 deletions
  1. 13 5
      fcl/db/bufdataset.inc
  2. 114 1
      fcl/db/database.inc
  3. 16 1
      fcl/db/dataset.inc
  4. 41 31
      fcl/db/db.pp
  5. 17 1
      fcl/db/dbs.inc

+ 13 - 5
fcl/db/bufdataset.inc

@@ -32,6 +32,12 @@ begin
   inherited destroy;
   inherited destroy;
 end;
 end;
 
 
+Function TBufDataset.GetCanModify: Boolean;
+
+begin
+  Result:= False;
+end;
+
 function TBufDataset.AllocRecordBuffer: PChar;
 function TBufDataset.AllocRecordBuffer: PChar;
 
 
 begin
 begin
@@ -84,13 +90,13 @@ end;
 
 
 function TBufDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
 function TBufDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
 begin
 begin
-  if FIsEOF then
-    Result := grEOF
-  else begin
+  begin
     Result := grOK;
     Result := grOK;
     case GetMode of
     case GetMode of
       gmPrior :
       gmPrior :
-        if FBCurrentRecord <= 0 then
+        if FIsBOF then
+          result := grBOF
+        else if FBCurrentRecord <= 0 then
           begin
           begin
           Result := grBOF;
           Result := grBOF;
           FBCurrentRecord := -1;
           FBCurrentRecord := -1;
@@ -104,7 +110,9 @@ begin
         if (FBCurrentRecord < 0) or (FBCurrentRecord >= RecordCount) then
         if (FBCurrentRecord < 0) or (FBCurrentRecord >= RecordCount) then
           Result := grError;
           Result := grError;
       gmNext :
       gmNext :
-        if FBCurrentRecord >= (FBRecordCount - 1) then
+        if FIsEOF then
+          result := grEOF
+        else if FBCurrentRecord >= (FBRecordCount - 1) then
           begin
           begin
           if getnextpacket > 0 then
           if getnextpacket > 0 then
             begin
             begin

+ 114 - 1
fcl/db/database.inc

@@ -58,6 +58,7 @@ begin
     else
     else
       begin
       begin
       Closedatasets;
       Closedatasets;
+      Closetransactions;
       DoInternalDisConnect;
       DoInternalDisConnect;
       if csloading in ComponentState then
       if csloading in ComponentState then
         FOpenAfterRead := false;
         FOpenAfterRead := false;
@@ -79,6 +80,7 @@ begin
   Inherited Create(AOwner);
   Inherited Create(AOwner);
   FParams:=TStringlist.Create;
   FParams:=TStringlist.Create;
   FDatasets:=TList.Create;
   FDatasets:=TList.Create;
+  FTransactions:=TList.Create;
 end;
 end;
 
 
 destructor TDatabase.Destroy;
 destructor TDatabase.Destroy;
@@ -86,7 +88,9 @@ destructor TDatabase.Destroy;
 begin
 begin
   Connected:=False;
   Connected:=False;
   RemoveDatasets;
   RemoveDatasets;
+  RemoveTransactions;
   FDatasets.Free;
   FDatasets.Free;
+  FTransactions.Free;
   FParams.Free;
   FParams.Free;
   Inherited Destroy;
   Inherited Destroy;
 end;
 end;
@@ -109,6 +113,18 @@ begin
     end;
     end;
 end;
 end;
 
 
+procedure TDatabase.CloseTransactions;
+
+Var I : longint;
+
+begin
+  If Assigned(FTransactions) then
+    begin
+    For I:=FTransactions.Count-1 downto 0 do
+      TDBTransaction(FTransactions[i]).EndTransaction;
+    end;
+end;
+
 procedure TDatabase.RemoveDataSets;
 procedure TDatabase.RemoveDataSets;
 
 
 Var I : longint;
 Var I : longint;
@@ -119,6 +135,16 @@ begin
       TDBDataset(FDataSets[i]).Database:=Nil;
       TDBDataset(FDataSets[i]).Database:=Nil;
 end;
 end;
 
 
+procedure TDatabase.RemoveTransactions;
+
+Var I : longint;
+
+begin
+  If Assigned(FTransactions) then
+    For I:=FTransactions.Count-1 downto 0 do
+      TDBTransaction(FTransactions[i]).Database:=Nil;
+end;
+
 procedure TDatabase.Open;
 procedure TDatabase.Open;
 
 
 begin
 begin
@@ -135,6 +161,14 @@ begin
     Result:=0;
     Result:=0;
 end;
 end;
 
 
+Function TDatabase.GetTransactionCount : Longint;
+
+begin
+  If Assigned(FTransactions) Then
+    Result:=FTransactions.Count
+  else
+    Result:=0;
+end;
 
 
 Function TDatabase.GetDataset(Index : longint) : TDBDataset;
 Function TDatabase.GetDataset(Index : longint) : TDBDataset;
 
 
@@ -145,6 +179,15 @@ begin
     DatabaseError(SNoDatasets);
     DatabaseError(SNoDatasets);
 end;
 end;
 
 
+Function TDatabase.GetTransaction(Index : longint) : TDBtransaction;
+
+begin
+  If Assigned(FTransactions) then
+    Result:=TDBTransaction(FTransactions[Index])
+  else
+    DatabaseError(SNoTransactions);
+end;
+
 procedure TDatabase.RegisterDataset (DS : TDBDataset);
 procedure TDatabase.RegisterDataset (DS : TDBDataset);
 
 
 Var I : longint;
 Var I : longint;
@@ -157,6 +200,18 @@ begin
     DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
     DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
 end;
 end;
 
 
+procedure TDatabase.RegisterTransaction (TA : TDBTransaction);
+
+Var I : longint;
+
+begin
+  I:=FTransactions.IndexOf(TA);
+  If I=-1 then
+    FTransactions.Add(TA)
+  else
+    DatabaseErrorFmt(STransactionRegistered,[TA.Name]);
+end;
+
 procedure TDatabase.UnRegisterDataset (DS : TDBDataset);
 procedure TDatabase.UnRegisterDataset (DS : TDBDataset);
 
 
 Var I : longint;
 Var I : longint;
@@ -169,6 +224,19 @@ begin
     DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
     DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
 end;
 end;
 
 
+procedure TDatabase.UnRegisterTransaction (TA : TDBTransaction);
+
+Var I : longint;
+
+begin
+  I:=FTransactions.IndexOf(TA);
+  If I<>-1 then
+    FTransactions.Delete(I)
+  else
+    DatabaseErrorFmt(SNoTransactionRegistered,[TA.Name]);
+end;
+
+
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     TDBdataset
     TDBdataset
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
@@ -201,10 +269,55 @@ begin
   Inherited;
   Inherited;
 end;
 end;
 
 
+{ ---------------------------------------------------------------------
+    TDBTransaction
+  ---------------------------------------------------------------------}
+
+Procedure TDBTransaction.SetDatabase (Value : TDatabase);
+
+begin
+//  CheckInactive;
+  If Value<>FDatabase then
+    begin
+    If Assigned(FDatabase) then
+      FDatabase.UnregisterTransaction(Self);
+    If Value<>Nil Then
+      Value.RegisterTransaction(Self);
+    FDatabase:=Value;
+    end;
+end;
+
+Procedure TDBTransaction.CheckDatabase;
+
+begin
+  If (FDatabase=Nil) then
+    DatabaseError(SErrNoDatabaseAvailable,Self)
+end;
+
+Destructor TDBTransaction.Destroy;
+
+begin
+  Database:=Nil;
+  Inherited;
+end;
+
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2004-07-25 11:32:40  michael
+  Revision 1.6  2004-09-26 16:55:24  michael
+  * big patch from Joost van der Sluis
+   bufdataset.inc:
+    fix getrecord (prior)
+    getcanmodify default false
+  database.inc / db.inc:
+    Added transactions
+  dataset.inc:
+    raise error if trying to insert into an readonly dataset
+  db.inc:
+    remove published properties from bufdataset
+    changed ancestor of tbufdataset to tdbdataset
+
+  Revision 1.5  2004/07/25 11:32:40  michael
   * Patches from Joost van der Sluis
   * Patches from Joost van der Sluis
     interbase.pp:
     interbase.pp:
         * Removed unused Fprepared
         * Removed unused Fprepared

+ 16 - 1
fcl/db/dataset.inc

@@ -1006,6 +1006,8 @@ Procedure TDataset.Delete;
 
 
 
 
 begin
 begin
+  If Not CanModify then
+    DatabaseError(SDatasetReadOnly,Self);
   if State in [dsInsert] then
   if State in [dsInsert] then
   begin
   begin
     Cancel;
     Cancel;
@@ -1721,7 +1723,20 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.23  2004-09-15 12:22:33  michael
+  Revision 1.24  2004-09-26 16:55:24  michael
+  * big patch from Joost van der Sluis
+   bufdataset.inc:
+    fix getrecord (prior)
+    getcanmodify default false
+  database.inc / db.inc:
+    Added transactions
+  dataset.inc:
+    raise error if trying to insert into an readonly dataset
+  db.inc:
+    remove published properties from bufdataset
+    changed ancestor of tbufdataset to tdbdataset
+
+  Revision 1.23  2004/09/15 12:22:33  michael
   Suggested fix from Luiz Americo to .resync method
   Suggested fix from Luiz Americo to .resync method
 
 
   Revision 1.22  2004/08/30 12:02:17  michael
   Revision 1.22  2004/08/30 12:02:17  michael

+ 41 - 31
fcl/db/db.pp

@@ -1182,16 +1182,32 @@ type
 
 
   TDBDatasetClass = Class of TDBDataset;
   TDBDatasetClass = Class of TDBDataset;
   TDBDataset = Class(TDataset)
   TDBDataset = Class(TDataset)
+    Private
+      FDatabase : TDatabase;
+    Protected
+      Procedure SetDatabase (Value : TDatabase); virtual;
+      Procedure CheckDatabase;
+    Public
+      Destructor destroy; override;
+      Property DataBase : TDatabase Read FDatabase Write SetDatabase;
+    end;
+
+ { TDBTransaction }
+
+  TDBTransactionClass = Class of TDBTransaction;
+  TDBTransaction = Class(TComponent)
     Private
     Private
       FDatabase : TDatabase;
       FDatabase : TDatabase;
       Procedure SetDatabase (Value : TDatabase);
       Procedure SetDatabase (Value : TDatabase);
     Protected
     Protected
       Procedure CheckDatabase;
       Procedure CheckDatabase;
     Public
     Public
+      procedure EndTransaction; virtual; abstract;
       Destructor destroy; override;
       Destructor destroy; override;
       Property DataBase : TDatabase Read FDatabase Write SetDatabase;
       Property DataBase : TDatabase Read FDatabase Write SetDatabase;
     end;
     end;
 
 
+
   { TDatabase }
   { TDatabase }
 
 
   TLoginEvent = procedure(Database: TDatabase;
   TLoginEvent = procedure(Database: TDatabase;
@@ -1204,6 +1220,7 @@ type
     FConnected : Boolean;
     FConnected : Boolean;
     FDataBaseName : String;
     FDataBaseName : String;
     FDataSets : TList;
     FDataSets : TList;
+    FTransactions : TList;
     FDirectory : String;
     FDirectory : String;
     FKeepConnection : Boolean;
     FKeepConnection : Boolean;
     FLoginPrompt : Boolean;
     FLoginPrompt : Boolean;
@@ -1212,11 +1229,16 @@ type
     FSQLBased : Boolean;
     FSQLBased : Boolean;
     FOpenAfterRead : boolean;
     FOpenAfterRead : boolean;
     Function GetDataSetCount : Longint;
     Function GetDataSetCount : Longint;
+    Function GetTransactionCount : Longint;
     Function GetDataset(Index : longint) : TDBDataset;
     Function GetDataset(Index : longint) : TDBDataset;
+    Function GetTransaction(Index : longint) : TDBTransaction;
     procedure SetConnected (Value : boolean);
     procedure SetConnected (Value : boolean);
     procedure RegisterDataset (DS : TDBDataset);
     procedure RegisterDataset (DS : TDBDataset);
+    procedure RegisterTransaction (TA : TDBTransaction);
     procedure UnRegisterDataset (DS : TDBDataset);
     procedure UnRegisterDataset (DS : TDBDataset);
+    procedure UnRegisterTransaction(TA : TDBTransaction);
     procedure RemoveDataSets;
     procedure RemoveDataSets;
+    procedure RemoveTransactions;
   protected
   protected
     Procedure CheckConnected;
     Procedure CheckConnected;
     Procedure CheckDisConnected;
     Procedure CheckDisConnected;
@@ -1230,10 +1252,13 @@ type
     procedure Close;
     procedure Close;
     procedure Open;
     procedure Open;
     procedure CloseDataSets;
     procedure CloseDataSets;
+    procedure CloseTransactions;
     procedure StartTransaction; virtual; abstract;
     procedure StartTransaction; virtual; abstract;
     procedure EndTransaction; virtual; abstract;
     procedure EndTransaction; virtual; abstract;
     property DataSetCount: Longint read GetDataSetCount;
     property DataSetCount: Longint read GetDataSetCount;
     property DataSets[Index: Longint]: TDBDataSet read GetDataSet;
     property DataSets[Index: Longint]: TDBDataSet read GetDataSet;
+    property TransactionCount: Longint read GetTransactionCount;
+    property Transactions[Index: Longint]: TDBTransaction read GetTransaction;
     property Directory: string read FDirectory write FDirectory;
     property Directory: string read FDirectory write FDirectory;
     property IsSQLBased: Boolean read FSQLBased;
     property IsSQLBased: Boolean read FSQLBased;
   published
   published
@@ -1253,7 +1278,7 @@ type
     BookmarkFlag : TBookmarkFlag;
     BookmarkFlag : TBookmarkFlag;
   end;
   end;
 
 
-  TBufDataset = class(TDataSet)
+  TBufDataset = class(TDBDataSet)
   private
   private
     FBBuffers : TBufferArray;
     FBBuffers : TBufferArray;
     FBRecordCount : integer;
     FBRecordCount : integer;
@@ -1265,6 +1290,7 @@ type
   protected
   protected
     function  AllocRecordBuffer: PChar; override;
     function  AllocRecordBuffer: PChar; override;
     procedure FreeRecordBuffer(var Buffer: PChar); override;
     procedure FreeRecordBuffer(var Buffer: PChar); override;
+    function  GetCanModify: Boolean; override;
     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
     procedure InternalOpen; override;
     procedure InternalOpen; override;
     procedure InternalClose; override;
     procedure InternalClose; override;
@@ -1284,35 +1310,6 @@ type
   public
   public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
-  published
-    // redeclared data set properties
-    property Active;
-//    property FieldDefs stored FieldDefsStored;
-    property Filter;
-    property Filtered;
-    property FilterOptions;
-    property BeforeOpen;
-    property AfterOpen;
-    property BeforeClose;
-    property AfterClose;
-    property BeforeInsert;
-    property AfterInsert;
-    property BeforeEdit;
-    property AfterEdit;
-    property BeforePost;
-    property AfterPost;
-    property BeforeCancel;
-    property AfterCancel;
-    property BeforeDelete;
-    property AfterDelete;
-    property BeforeScroll;
-    property AfterScroll;
-    property OnCalcFields;
-    property OnDeleteError;
-    property OnEditError;
-    property OnFilterRecord;
-    property OnNewRecord;
-    property OnPostError;
   end;
   end;
 
 
 
 
@@ -1575,7 +1572,20 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.23  2004-08-31 09:51:27  michael
+  Revision 1.24  2004-09-26 16:55:24  michael
+  * big patch from Joost van der Sluis
+   bufdataset.inc:
+    fix getrecord (prior)
+    getcanmodify default false
+  database.inc / db.inc:
+    Added transactions
+  dataset.inc:
+    raise error if trying to insert into an readonly dataset
+  db.inc:
+    remove published properties from bufdataset
+    changed ancestor of tbufdataset to tdbdataset
+
+  Revision 1.23  2004/08/31 09:51:27  michael
   + Initial TBufDataset by Joost van der Sluis
   + Initial TBufDataset by Joost van der Sluis
 
 
   Revision 1.22  2004/08/23 07:30:19  michael
   Revision 1.22  2004/08/23 07:30:19  michael

+ 17 - 1
fcl/db/dbs.inc

@@ -35,8 +35,11 @@ Const
   SInactiveDataset = 'Operation cannot be performed on an inactive dataset';
   SInactiveDataset = 'Operation cannot be performed on an inactive dataset';
   SActiveDataset = 'Operation cannot be performed on an active dataset';
   SActiveDataset = 'Operation cannot be performed on an active dataset';
   SNoDatasets = 'No datasets are attached to the database';
   SNoDatasets = 'No datasets are attached to the database';
+  SNoTransactions = 'No transactions are attached to the database';
   SDatasetRegistered = 'Dataset already registered : "%s"';
   SDatasetRegistered = 'Dataset already registered : "%s"';
+  STransactionRegistered = 'Transaction already registered : "%s"';
   SNoDatasetRegistered = 'No such dataset registered : "%s"';
   SNoDatasetRegistered = 'No such dataset registered : "%s"';
+  SNoTransactionRegistered = 'No such transaction registered : "%s"';
   SNotConnected = 'Operation cannot be performed on an disconnected database';
   SNotConnected = 'Operation cannot be performed on an disconnected database';
   SConnected = 'Operation cannot be performed on an connected database';
   SConnected = 'Operation cannot be performed on an connected database';
   SUniDirectional = 'Operation cannot be performed on an unidirectional dataset';
   SUniDirectional = 'Operation cannot be performed on an unidirectional dataset';
@@ -49,7 +52,20 @@ Const
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.6  2004-08-13 07:06:02  michael
+  Revision 1.7  2004-09-26 16:55:24  michael
+  * big patch from Joost van der Sluis
+   bufdataset.inc:
+    fix getrecord (prior)
+    getcanmodify default false
+  database.inc / db.inc:
+    Added transactions
+  dataset.inc:
+    raise error if trying to insert into an readonly dataset
+  db.inc:
+    remove published properties from bufdataset
+    changed ancestor of tbufdataset to tdbdataset
+
+  Revision 1.6  2004/08/13 07:06:02  michael
   + Rework of buffer management by Joost Van der Sluis
   + Rework of buffer management by Joost Van der Sluis
 
 
   Revision 1.5  2003/08/16 16:42:21  michael
   Revision 1.5  2003/08/16 16:42:21  michael