* Moved .ReadOnly property from TSQLQuery to TBufDataset

git-svn-id: trunk@21254 -

packages/fcl-db/src/base/bufdataset.pas

@@ -407,6 +407,7 @@ type
 
     FFilterBuffer   : TRecordBuffer;
     FBRecordCount   : integer;
+    FReadOnly       : Boolean;
 
     FSavedState     : TDatasetState;
     FPacketRecords  : integer;
@@ -495,6 +496,7 @@ type
     procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
     procedure BeforeRefreshOpenCursor; virtual;
     procedure DoFilterRecord(out Acceptable: Boolean); virtual;
+    procedure SetReadOnly(AValue: Boolean); virtual;
   {abstracts, must be overidden by descendents}
     function Fetch : boolean; virtual;
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
@@ -531,6 +533,7 @@ type
 
     property ChangeCount : Integer read GetChangeCount;
     property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount default 2;
+    property ReadOnly : Boolean read FReadOnly write SetReadOnly default false;
   published
     property FileName : string read FFileName write FFileName;
     property PacketRecords : Integer read FPacketRecords write SetPacketRecords default 10;
@@ -550,6 +553,7 @@ type
     Property AutoCalcFields;
     Property Filter;
     Property Filtered;
+    Property Readonly;
     Property AfterCancel;
     Property AfterClose;
     Property AfterDelete;
@@ -1079,7 +1083,7 @@ end;
 
 Function TCustomBufDataset.GetCanModify: Boolean;
 begin
-  Result:= True;
+  Result:=not (UniDirectional or ReadOnly);
 end;
 
 function TCustomBufDataset.IntAllocRecordBuffer: TRecordBuffer;
@@ -1483,6 +1487,11 @@ begin
     end;
 end;
 
+procedure TCustomBufDataset.SetReadOnly(AValue: Boolean);
+begin
+  FReadOnly:=AValue;
+end;
+
 function TCustomBufDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
 
 var Acceptable : Boolean;

packages/fcl-db/src/sqldb/sqldb.pp

@@ -212,7 +212,6 @@ type
     FDeleteSQL           : TStringList;
     FIsEOF               : boolean;
     FLoadingFieldDefs    : boolean;
-    FReadOnly            : boolean;
     FUpdateMode          : TUpdateMode;
     FParams              : TParams;
     FusePrimaryKeyAsKey  : Boolean;
@@ -241,7 +240,6 @@ type
     function GetStatementType : TStatementType;
     procedure SetDeleteSQL(const AValue: TStringlist);
     procedure SetInsertSQL(const AValue: TStringlist);
-    procedure SetReadOnly(AValue : Boolean);
     procedure SetParseSQL(AValue : Boolean);
     procedure SetSQL(const AValue: TStringlist);
     procedure SetUpdateSQL(const AValue: TStringlist);
@@ -275,6 +273,7 @@ type
     Procedure SetDataSource(AValue : TDatasource);
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
     procedure BeforeRefreshOpenCursor; override;
+    procedure SetReadOnly(AValue : Boolean); override;
     Function LogEvent(EventType : TDBEventType) : Boolean;
     Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
   public
@@ -322,7 +321,6 @@ type
   // protected
     property SchemaType : TSchemaType read FSchemaType default stNoSchema;
     property Transaction;
-    property ReadOnly : Boolean read FReadOnly write SetReadOnly default false;
     property SQL : TStringlist read FSQL write SetSQL;
     property UpdateSQL : TStringlist read FUpdateSQL write SetUpdateSQL;
     property InsertSQL : TStringlist read FInsertSQL write SetInsertSQL;
@@ -1482,7 +1480,6 @@ begin
 
   FServerIndexDefs := TServerIndexDefs.Create(Self);
 
-  FReadOnly := false;
   FParseSQL := True;
 
   FServerFiltered := False;
@@ -1517,7 +1514,7 @@ procedure TCustomSQLQuery.SetReadOnly(AValue : Boolean);
 
 begin
   CheckInactive;
-  FReadOnly:=AValue;
+  inherited SetReadOnly(AValue);
 end;
 
 procedure TCustomSQLQuery.SetParseSQL(AValue : Boolean);
@@ -1707,7 +1704,7 @@ Function TCustomSQLQuery.GetCanModify: Boolean;
 begin
   // the test for assigned(FCursor) is needed for the case that the dataset isn't opened
   if assigned(FCursor) and (FCursor.FStatementType = stSelect) then
-    Result:= FUpdateable and (not FReadOnly) and (not IsUniDirectional)
+    Result:= FUpdateable and (not ReadOnly) and (not IsUniDirectional)
   else
     Result := False;
 end;

packages/fcl-db/tests/testdbbasics.pas

@@ -79,6 +79,7 @@ type
     procedure TestBufDatasetCancelUpd1;
     procedure TestMultipleDeleteUpdateBuffer;
     procedure TestDoubleDelete;
+    procedure TestReadOnly;
   // index tests
     procedure TestAddIndexInteger;
     procedure TestAddIndexSmallInt;
@@ -1391,6 +1392,18 @@ begin
     end;
 end;
 
+procedure TTestBufDatasetDBBasics.TestReadOnly;
+var
+  ds: TCustomBufDataset;
+begin
+  ds := DBConnector.GetFieldDataset as TCustomBufDataset;
+  with ds do
+    begin
+    ReadOnly:=true;
+    CheckFalse(CanModify);
+    end;
+end;
+
 procedure TTestBufDatasetDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset);
 var i : integer;
 begin