Browse Source

* TDatabase should be a TCustomConnection descendent, not the other way around
* Mapped ftTParadoxOLE, ftTDBaseOLE and ftTypedBinary to TBlobField

git-svn-id: trunk@6542 -

joost 18 years ago
parent
commit
ac22bd4474
2 changed files with 142 additions and 133 deletions
  1. 89 87
      fcl/db/database.inc
  2. 53 46
      fcl/db/db.pp

+ 89 - 87
fcl/db/database.inc

@@ -32,60 +32,25 @@ begin
     DatabaseError(SConnected,Self);
 end;
 
-Procedure TDatabase.InternalHandleException;
-
+procedure TDatabase.DoConnect;
 begin
-  if assigned(classes.ApplicationHandleException) then
-    classes.ApplicationHandleException(self)
-  else
-    ShowException(ExceptObject,ExceptAddr);
+  DoInternalConnect;
+  FConnected := True;
 end;
 
-procedure TDataBase.Loaded;
-
+procedure TDatabase.DoDisconnect;
 begin
-  inherited;
-  try
-    if FOpenAfterRead then
-      SetConnected(true);
-  except
-    if csDesigning in Componentstate then
-      InternalHandleException
-    else
-      raise;
-  end;
+  Closedatasets;
+  Closetransactions;
+  DoInternalDisConnect;
+  if csloading in ComponentState then
+    FOpenAfterRead := false;
+  FConnected := False;
 end;
 
-procedure TDataBase.SetConnected (Value : boolean);
-
+function TDatabase.GetConnected: boolean;
 begin
-  If Value<>FConnected then
-    begin
-    If Value then
-      begin
-      if csReading in ComponentState then
-        begin
-        FOpenAfterRead := true;
-        exit;
-        end
-      else
-//        try
-          DoInternalConnect;
-//        except
-//          on e: EDatabaseError do DoInternalDisconnect;
-      //    raise;
-//        end; {try}
-      end
-    else
-      begin
-      Closedatasets;
-      Closetransactions;
-      DoInternalDisConnect;
-      if csloading in ComponentState then
-        FOpenAfterRead := false;
-      end;
-    FConnected:=Value;
-    end;
+  Result:= FConnected;
 end;
 
 constructor TDatabase.Create(AOwner: TComponent);
@@ -109,12 +74,6 @@ begin
   Inherited Destroy;
 end;
 
-procedure TDatabase.Close;
-
-begin
-  Connected:=False;
-end;
-
 procedure TDatabase.CloseDataSets;
 
 Var I : longint;
@@ -123,7 +82,7 @@ begin
   If Assigned(FDatasets) then
     begin
     For I:=FDatasets.Count-1 downto 0 do
-      TDBDataset(FDatasets[i]).Close;
+      TDataset(FDatasets[i]).Close;
     end;
 end;
 
@@ -159,13 +118,6 @@ begin
       TDBTransaction(FTransactions[i]).Database:=Nil;
 end;
 
-procedure TDatabase.Open;
-
-begin
-  Connected:=True;
-end;
-
-
 Function TDatabase.GetDataSetCount : Longint;
 
 begin
@@ -184,11 +136,11 @@ begin
     Result:=0;
 end;
 
-Function TDatabase.GetDataset(Index : longint) : TDBDataset;
+Function TDatabase.GetDataset(Index : longint) : TDataset;
 
 begin
   If Assigned(FDatasets) then
-    Result:=TDBDataset(FDatasets[Index])
+    Result:=TDataset(FDatasets[Index])
   else
     DatabaseError(SNoDatasets);
 end;
@@ -475,6 +427,24 @@ begin
   FAfterConnect:=AValue;
 end;
 
+function TCustomConnection.GetDataSet(Index: Longint): TDataSet;
+begin
+  Result := nil;
+end;
+
+function TCustomConnection.GetDataSetCount: Longint;
+begin
+  Result := 0;
+end;
+
+procedure TCustomConnection.InternalHandleException;
+begin
+  if assigned(classes.ApplicationHandleException) then
+    classes.ApplicationHandleException(self)
+  else
+    ShowException(ExceptObject,ExceptAddr);
+end;
+
 procedure TCustomConnection.SetAfterDisconnect(const AValue: TNotifyEvent);
 begin
   if FAfterDisconnect=AValue then exit;
@@ -487,28 +457,43 @@ begin
   FBeforeConnect:=AValue;
 end;
 
-procedure TCustomConnection.SetBeforeDisconnect(const AValue: TNotifyEvent);
-begin
-  if FBeforeDisconnect=AValue then exit;
-  FBeforeDisconnect:=AValue;
-end;
-
-procedure TCustomConnection.DoInternalConnect;
+procedure TCustomConnection.SetConnected(Value: boolean);
 begin
-  if Assigned(BeforeConnect) then
-    BeforeConnect(self);
-  DoConnect;
-  if Assigned(AfterConnect) then
-    AfterConnect(self);
+  If Value<>Connected then
+    begin
+    If Value then
+      begin
+      if csReading in ComponentState then
+        begin
+        FStreamedConnected := true;
+        exit;
+        end
+      else
+        begin
+        if Assigned(BeforeConnect) then
+          BeforeConnect(self);
+        if FLoginPrompt then if assigned(FOnLogin) then
+          FOnLogin(self,'','');
+        DoConnect;
+        if Assigned(AfterConnect) then
+          AfterConnect(self);
+        end;
+      end
+    else
+      begin
+      if Assigned(BeforeDisconnect) then
+        BeforeDisconnect(self);
+      DoDisconnect;
+      if Assigned(AfterDisconnect) then
+        AfterDisconnect(self);
+      end;
+    end;
 end;
 
-procedure TCustomConnection.DoInternalDisconnect;
+procedure TCustomConnection.SetBeforeDisconnect(const AValue: TNotifyEvent);
 begin
-  if Assigned(BeforeDisconnect) then
-    BeforeDisconnect(self);
-  DoDisconnect;
-  if Assigned(AfterDisconnect) then
-    AfterDisconnect(self);
+  if FBeforeDisconnect=AValue then exit;
+  FBeforeDisconnect:=AValue;
 end;
 
 procedure TCustomConnection.DoConnect;
@@ -526,19 +511,36 @@ end;
 function TCustomConnection.GetConnected: boolean;
 
 begin
-  Result := Connected;
+  Result := False;
 end;
 
-procedure TCustomConnection.StartTransaction;
-
+procedure TCustomConnection.Loaded;
 begin
-  // Do nothing yet
+  inherited Loaded;
+  try
+    if FStreamedConnected then
+      SetConnected(true);
+  except
+    if csDesigning in Componentstate then
+      InternalHandleException
+    else
+      raise;
+  end;
 end;
 
-procedure TCustomConnection.EndTransaction;
+procedure TCustomConnection.Close;
+begin
+  Connected := False;
+end;
 
+destructor TCustomConnection.Destroy;
 begin
-  // Do nothing yet
+  Connected:=False;
+  Inherited Destroy;
 end;
 
+procedure TCustomConnection.Open;
+begin
+  Connected := True;
+end;
 

+ 53 - 46
fcl/db/db.pp

@@ -1426,13 +1426,56 @@ type
     property Active : boolean read FActive write setactive;
   end;
 
-  { TDatabase }
+    { TCustomConnection }
 
   TLoginEvent = procedure(Sender: TObject; Username, Password: string) of object;
 
+  TCustomConnection = class(TComponent)
+  private
+    FAfterConnect: TNotifyEvent;
+    FAfterDisconnect: TNotifyEvent;
+    FBeforeConnect: TNotifyEvent;
+    FBeforeDisconnect: TNotifyEvent;
+    FLoginPrompt: Boolean;
+    FOnLogin: TLoginEvent;
+    FStreamedConnected: Boolean;
+    procedure SetAfterConnect(const AValue: TNotifyEvent);
+    procedure SetAfterDisconnect(const AValue: TNotifyEvent);
+    procedure SetBeforeConnect(const AValue: TNotifyEvent);
+    procedure SetBeforeDisconnect(const AValue: TNotifyEvent);
+  protected
+    procedure DoConnect; virtual;
+    procedure DoDisconnect; virtual;
+    function GetConnected : boolean; virtual;
+    Function GetDataset(Index : longint) : TDataset; virtual;
+    Function GetDataSetCount : Longint; virtual;
+    procedure InternalHandleException; virtual;
+    procedure Loaded; override;
+    procedure SetConnected (Value : boolean); virtual;
+  public
+    procedure Close;
+    destructor Destroy; override;
+    procedure Open;
+    property DataSetCount: Longint read GetDataSetCount;
+    property DataSets[Index: Longint]: TDataSet read GetDataSet;
+  published
+    property Connected: Boolean read GetConnected write SetConnected;
+    property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
+    property Streamedconnected: Boolean read FStreamedConnected write FStreamedConnected;
+
+    property AfterConnect : TNotifyEvent read FAfterConnect write SetAfterConnect;
+    property AfterDisconnect : TNotifyEvent read FAfterDisconnect write SetAfterDisconnect;
+    property BeforeConnect : TNotifyEvent read FBeforeConnect write SetBeforeConnect;
+    property BeforeDisconnect : TNotifyEvent read FBeforeDisconnect write SetBeforeDisconnect;
+    property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
+  end;
+
+
+  { TDatabase }
+
   TDatabaseClass = Class Of TDatabase;
 
-  TDatabase = class(TComponent)
+  TDatabase = class(TCustomConnection)
   private
     FConnected : Boolean;
     FDataBaseName : String;
@@ -1440,16 +1483,11 @@ type
     FTransactions : TList;
     FDirectory : String;
     FKeepConnection : Boolean;
-    FLoginPrompt : Boolean;
-    FOnLogin : TLoginEvent;
     FParams : TStrings;
     FSQLBased : Boolean;
     FOpenAfterRead : boolean;
-    Function GetDataSetCount : Longint;
     Function GetTransactionCount : Longint;
-    Function GetDataset(Index : longint) : TDBDataset;
     Function GetTransaction(Index : longint) : TDBTransaction;
-    procedure SetConnected (Value : boolean);
     procedure RegisterDataset (DS : TDBDataset);
     procedure RegisterTransaction (TA : TDBTransaction);
     procedure UnRegisterDataset (DS : TDBDataset);
@@ -1459,22 +1497,21 @@ type
   protected
     Procedure CheckConnected;
     Procedure CheckDisConnected;
-    procedure InternalHandleException; virtual;
-    procedure Loaded; override;
+    procedure DoConnect; override;
+    procedure DoDisconnect; override;
+    function GetConnected : boolean; override;
+    Function GetDataset(Index : longint) : TDataset; override;
+    Function GetDataSetCount : Longint; override;
     Procedure DoInternalConnect; Virtual;Abstract;
     Procedure DoInternalDisConnect; Virtual;Abstract;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    procedure Close;
-    procedure Open;
     procedure CloseDataSets;
     procedure CloseTransactions;
 //    procedure ApplyUpdates;
     procedure StartTransaction; virtual; abstract;
     procedure EndTransaction; virtual; abstract;
-    property DataSetCount: Longint read GetDataSetCount;
-    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;
@@ -1483,39 +1520,9 @@ type
     property Connected: Boolean read FConnected write SetConnected;
     property DatabaseName: string read FDatabaseName write FDatabaseName;
     property KeepConnection: Boolean read FKeepConnection write FKeepConnection;
-    property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
     property Params : TStrings read FParams Write FParams;
-    property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
   end;
 
-    { TCustomConnection }
-
-  TCustomConnection = class(TDatabase)
-  private
-    FAfterConnect: TNotifyEvent;
-    FAfterDisconnect: TNotifyEvent;
-    FBeforeConnect: TNotifyEvent;
-    FBeforeDisconnect: TNotifyEvent;
-    procedure SetAfterConnect(const AValue: TNotifyEvent);
-    procedure SetAfterDisconnect(const AValue: TNotifyEvent);
-    procedure SetBeforeConnect(const AValue: TNotifyEvent);
-    procedure SetBeforeDisconnect(const AValue: TNotifyEvent);
-  protected
-    procedure DoInternalConnect; override;
-    procedure DoInternalDisconnect; override;
-    procedure DoConnect; virtual;
-    procedure DoDisconnect; virtual;
-    function GetConnected : boolean; virtual;
-    procedure StartTransaction; override;
-    procedure EndTransaction; override;
-  published
-    property AfterConnect : TNotifyEvent read FAfterConnect write SetAfterConnect;
-    property BeforeConnect : TNotifyEvent read FBeforeConnect write SetBeforeConnect;
-    property AfterDisconnect : TNotifyEvent read FAfterDisconnect write SetAfterDisconnect;
-    property BeforeDisconnect : TNotifyEvent read FBeforeDisconnect write SetBeforeDisconnect;
-  end;
-
-
 
   { TParam }
 
@@ -1761,9 +1768,9 @@ const
       { ftMemo} TMemoField,
       { ftGraphic} TGraphicField,
       { ftFmtMemo} TMemoField,
-      { ftParadoxOle} Nil,
-      { ftDBaseOle} Nil,
-      { ftTypedBinary} Nil,
+      { ftParadoxOle} TBlobField,
+      { ftDBaseOle} TBlobField,
+      { ftTypedBinary} TBlobField,
       { ftCursor} Nil,
       { ftFixedChar} TStringField,
       { ftWideString} Nil,