lazarus-ccr/components/flashfiler/sourcelaz/ffdbbase.pas

{*********************************************************}
{* FlashFiler: Support classes for FFDB                  *}
{*********************************************************}

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower FlashFiler
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{$I ffdefine.inc}

unit ffdbbase;

interface

uses
  classes,
  db,
  ffclbase,                                                            {!!.06}
  ffsrbde,
  ffllbase,
  ffsrmgr;

{$I ffdscnst.inc}

var
  ffStrResDataSet : TffStringResource;

type
  EffDatabaseError = class(EDatabaseError)
  protected {private}
    deErrorCode : TffResult;
  protected
    function deGetErrorString : string;
  public
    constructor Create(const aMsg : string);
    constructor CreateViaCode(aErrorCode : TffResult; aDummy : Boolean);
    constructor CreateViaCodeFmt(const aErrorCode : TffResult;         {!!.06}
                                 const args : array of const;          {!!.06}
                                 const aDummy : Boolean);              {!!.06}
    constructor CreateWithObj(aObj : TComponent;
                        const aErrorCode : TffResult;
                        const aMsg : string);
    constructor CreateWithObjFmt(aObj : TComponent; const aErrorCode : TffResult;
                                 const args : array of const);         {!!.11}
    property ErrorCode : TffResult read deErrorCode;
    property ErrorString : string read deGetErrorString;
  end;

type
  TffDBListItem = class;
  TffDBList = class;

  TffDBListItem = class(TffComponent)
    protected {private}
      dbliActive       : Boolean;
      dbliDBName       : string;
      dbliDBOwner      : TffDBListItem;
      dbliDBOwnerName  : string;
      dbliFailedActive : Boolean;
      dbliFixing       : Boolean;
      dbliLoading      : Boolean;
      dbliMakeActive   : Boolean;
      dbliOwnedDBItems : TffDBList;
      dbliReqPropName  : string;
      dbliTemporary    : Boolean;                                      {!!.01}
        { The actual name of the required property corresponding to DBName. }
    protected
      dbliLoadPriority : Integer; {*not* private, descendants set it}
      dbliNeedsNoOwner : Boolean; {*not* private, descendants set it}

      function dbliGetDBOwner : TffDBListItem;
      function dbliGetDBOwnerName : string;
      function dbliGetOwned : Boolean;
      procedure dbliSetActive(const aValue : Boolean);
      procedure dbliSetDBName(const aName : string);
      procedure dbliSetDBOwner(const aDBOwner : TffDBListItem);
      procedure dbliSetDBOwnerName(const aName : string);

      procedure dbliClosePrim; virtual;
      function dbliCreateOwnedList : TffDBList; virtual;
      procedure dbliDBItemAdded(aItem : TffDBListItem); virtual;
      procedure dbliDBItemDeleted(aItem : TffDBListItem); virtual;
      procedure dbliNotifyDBOwnerChanged; virtual;
      procedure dbliDBOwnerChanged; virtual;
      function dbliFindDBOwner(const aName : string) : TffDBListItem; virtual;
      procedure dbliFreeTemporaryDependents;                           {!!.01}
      procedure dbliLoaded; virtual;
      procedure dbliMustBeClosedError; virtual;
      procedure dbliMustBeOpenError; virtual;
      procedure dbliOpenPrim; virtual;
      function dbliResolveDBOwner(const aName : string) : TffDBListItem;
      procedure dbliSwitchOwnerTo(const aDBOwner : TffDBListItem);

      property Active : Boolean
         read dbliActive
         write dbliSetActive
         default False;
      property Connected : Boolean
         read dbliActive
         write dbliSetActive
         default False;
      property DBName : string
         read dbliDBName
         write dbliSetDBName;
      property DBOwner : TffDBListItem
         read dbliGetDBOwner
         write dbliSetDBOwner;
      property DBOwnerName : string
         read dbliGetDBOwnerName
         write dbliSetDBOwnerName;
      property FixingFromStream : Boolean
         read dbliFixing
         write dbliFixing;
      property LoadPriority : Integer
         read dbliLoadPriority;
      property LoadingFromStream : Boolean
         read dbliLoading
         write dbliLoading;
      property NeedsNoOwner : Boolean
         read dbliNeedsNoOwner;
      property OwnedDBItems : TffDBList
         read dbliOwnedDBItems;
      property Temporary : Boolean                                     {!!.01}
         read dbliTemporary write dbliTemporary;                       {!!.01}
    public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;

      procedure Loaded; override;

      procedure Open;
      procedure CheckActive;
      procedure CheckInactive(const aCanClose : Boolean);
      procedure Close;
      procedure FFNotificationEx(const AOp : Byte; AFrom : TffComponent;
                                 const AData : TffWord32); override;
      procedure ForceClosed;

      property IsOwned : Boolean
         read dbliGetOwned;
      property LoadActiveFailed : Boolean
         read dbliFailedActive;
  end;

    { All list management was moved to TffComponent after documentation was
      released to the printers. This class does not store items anymore,
      instead it's methods reference the dependent list in TffComponent. This
      required the addition of a owner field. Owner references the item
      controlling a collection of other items. For instance, if the list
      belonged to a TffBaseClient, then this class would control TffSession
      components.}
  TffDBList = class(TffObject)
    protected {private}
      dblOwner : TffDBListItem; {controller of this list}
    protected
      function dblGetCount : Integer;
      function dblGetItem(aInx : Integer) : TffDBListItem;
      procedure dblFreeItem(aItem : TffDBListItem); virtual;
      procedure dblFreeUnownedItems;
    public
      constructor Create(aOwner : TffDBListItem);
      destructor Destroy; override;

      function FindItem(const aName : string; var aItem : TffDBListItem) : Boolean;
      procedure GetItem(const aName : string; var aItem : TffDBListItem);
      procedure GetItemNames(aList : TStrings);
      function IndexOfItem(aItem : TffDBListItem) : Integer;

      property Count : Integer
         read dblGetCount;
      property Items[aInx : Integer] : TffDBListItem
         read dblGetItem; default;
    end;

  TffDBStandaloneList = class
    protected {private}
      dblList : TffThreadList;
    protected
      function dblGetCount : integer;
      function dblGetItem(aInx : integer) : TffDBListItem;

      procedure dblCloseAllItems;
      procedure dblFreeItem(aItem : TffDBListItem); virtual;
      procedure dblFreeUnownedItems;
    public
      constructor Create;
      destructor Destroy; override;

      procedure AddItem(aItem : TffDBListItem);
      procedure DeleteItem(aItem : TffDBListItem);
      function FindItem(const aName : string; var aItem : TffDBListItem) : boolean;
      procedure GetItem(const aName : string; var aItem : TffDBListItem);
      procedure GetItemNames(aList : TStrings);
      function IndexOfItem(aItem : TffDBListItem) : integer;

      procedure BeginRead;                                             {!!.02}
      procedure BeginWrite;                                            {!!.02}
      procedure EndRead;                                               {!!.02}
      procedure EndWrite;                                              {!!.02}

      property Count : integer read dblGetCount;
      property Items[aInx : integer] : TffDBListItem read dblGetItem; default;
    end;


{---Helper routines---}
procedure Check(const aStatus : TffResult);
procedure RaiseFFErrorCode(const aErrorCode : TffResult);
procedure RaiseFFErrorMsg(const aMsg : string);
procedure RaiseFFErrorObj(aObj : TComponent; const aErrorCode : TffResult);
procedure RaiseFFErrorObjFmt(aObj : TComponent; const aErrorCode : TffResult;
                             args: array of const);
function IsPath(const Value : string) : Boolean;

{---Internal helper routines---}
procedure AddToFixupList(aItem : TffDBListItem);
procedure ApplyFixupList;

implementation

{$R ffdscnst.res}

uses
  dialogs,
  sysutils,
  forms,
  ffconst,
  ffllexcp,
  ffnetmsg;                                                            {!!.06}

{===Fixup list helper code===========================================}
{Notes: this fixup list is to ensure that components that depend on
        others being fully loaded from the DFM file first, are
        completely initialized only after the components they depend
        on are initialized.
        The properties whose values are deferred at load time are the
        DBOwner name and the Active properties. For example, a
        database component which has a session name for a session
        component that hasn't been completely loaded yet cannot itself
        be loaded properly.
        The fixup list ensures that components with a high load
        priority (1) are fully loaded before those with a lower load
        priority (4).}
var
  DBItemFixupList : TList;

{--------}
procedure CreateFixupList;
begin
  DBItemFixupList := TList.Create;
end;
{--------}
procedure DestroyFixupList;
begin
  if (DBItemFixupList <> nil) then begin
    DBItemFixupList.Destroy;
    DBItemFixupList := nil;
  end;
end;
{--------}
procedure AddToFixupList(aItem : TffDBListItem);
begin
  if (DBItemFixupList = nil) then
    CreateFixupList;
  if (DBItemFixupList.IndexOf(aItem) = -1) then
    DBItemFixupList.Add(aItem);
end;
{--------}
procedure ApplyFixupList;
var
  LoadPty : Integer;
  Inx     : Integer;
  Item    : TffDBListItem;
begin
  if (DBItemFixupList <> nil) then begin
    for LoadPty := 1 to 4 do begin
      for Inx := pred(DBItemFixupList.Count) downto 0 do begin
        Item := TffDBListItem(DBItemFixupList[Inx]);
        if (Item.LoadPriority = LoadPty) then begin
          Item.LoadingFromStream := false;
          Item.FixingFromStream := true;
          Item.dbliLoaded;
          Item.FixingFromStream := false;
          DBItemFixupList.Delete(Inx);
        end;
      end;
    end;
    if (DBItemFixupList.Count = 0) then
      DestroyFixupList;
  end;
end;
{====================================================================}


{===Interfaced helper routines=======================================}
procedure Check(const aStatus : TffResult);
begin
  if aStatus <> 0 then
    RaiseFFErrorCode(aStatus);
end;
{--------}
procedure RaiseFFErrorCode(const aErrorCode : TffResult);
begin
  raise EffDatabaseError.CreateViaCode(aErrorCode, False);
end;
{--------}
procedure RaiseFFErrorMsg(const aMsg : string);
begin
  raise EffDatabaseError.Create(aMsg);
end;
{--------}
procedure RaiseFFErrorObj(aObj : TComponent; const aErrorCode : TffResult);
begin
  raise EffDatabaseError.CreateWithObj(aObj, aErrorCode,
                                       ffStrResDataSet[aErrorCode]);
end;
{--------}
procedure RaiseFFErrorObjFmt(aObj : TComponent; const aErrorCode : TffResult;
                             args: array of const);
begin
  raise EffDatabaseError.CreateWithObjFmt(aObj, aErrorCode, args);
end;
{--------}
function IsPath(const Value : string) : Boolean;
begin
  Result := (Pos(':', Value) <> 0 ) or
            (Pos('\', Value) <> 0 ) or                                 {!!.05}
            (Value = '.') or                                           {!!.05}
            (Value = '..');                                            {!!.05}
end;
{====================================================================}


{===EffDatabaseError=================================================}
constructor EffDatabaseError.Create(const aMsg : string);
begin
  deErrorCode := 0;
  inherited CreateFmt(ffStrResDataSet[ffdse_NoErrorCode], [aMsg]);
end;
{--------}
constructor EffDatabaseError.CreateViaCode(aErrorCode : TffResult; aDummy : Boolean);
var
  Msg : string;
begin
  deErrorCode := aErrorCode;
  Msg := deGetErrorString;
  inherited CreateFmt(ffStrResDataSet[ffdse_HasErrorCode], [Msg, aErrorCode, aErrorCode]);
end;
{Begin !!.06}
{--------}
constructor EffDatabaseError.CreateViaCodeFmt(const aErrorCode : TffResult;
                                              const args : array of const;
                                              const aDummy : boolean);
var
  Msg : string;
begin
  deErrorCode := aErrorCode;
  Msg := deGetErrorString;
  inherited Create(Format(Msg, args));
end;
{End !!.06}
{--------}
constructor EffDatabaseError.CreateWithObj(aObj : TComponent;
                                     const aErrorCode : TffResult;
                                     const aMsg : string);
var
  ObjName : string;
begin
  deErrorCode := aErrorCode;
  if (aObj = nil) then
    ObjName := ffStrResDataSet[ffdse_NilPointer]
  else begin
    ObjName := aObj.Name;
    if (ObjName = '') then
      ObjName := Format(ffStrResDataSet[ffdse_UnnamedInst], [aObj.ClassName]);
  end;
  inherited CreateFmt(ffStrResDataSet[ffdse_InstNoCode], [ObjName, aMsg]);
end;
{--------}
constructor EffDatabaseError.CreateWithObjFmt(aObj : TComponent;
                                        const aErrorCode : TffResult;
                                        const args : array of const); {!!.11}
var
  Msg : string;
  ObjName : string;
begin
  deErrorCode := aErrorCode;
  Msg := format(deGetErrorString, args);

  if (aObj = nil) then
    ObjName := ffStrResDataSet[ffdse_NilPointer]
  else begin
    ObjName := aObj.Name;
    if (ObjName = '') then
      ObjName := Format(ffStrResDataSet[ffdse_UnnamedInst], [aObj.ClassName]);
  end;

  inherited CreateFmt(ffStrResDataSet[ffdse_InstCode],
                      [ObjName, Msg, aErrorCode, aErrorCode]);
end;
{--------}
function EffDatabaseError.deGetErrorString : string;
var
  PC : array [0..127] of char;
begin
  if (deErrorCode >= ffDSCNSTLow) and (deErrorCode <= ffDSCNSTHigh) then
    ffStrResDataSet.GetASCIIZ(deErrorCode, PC, sizeOf(DBIMSG))
  else if (deErrorCode >= ffLLCNSTLow) and (deErrorCode <= ffLLCNSTHigh) then
    ffStrResGeneral.GetASCIIZ(deErrorCode, PC, sizeOf(DBIMSG))
  else if (deErrorCode >= ffCLCNSTLow) and (deErrorCode <= ffCLCNSTHigh) then {!!.06}
    ffStrResClient.GetASCIIZ(deErrorCode, PC, SizeOf(DBIMSG))                 {!!.06}
  else
    GetErrorStringPrim(deErrorCode, PC);
  Result := StrPas(PC);
end;
{====================================================================}


{===TffDBList========================================================}
constructor TffDBList.Create(aOwner : TffDBListItem);
begin
  dblOwner := aOwner;
end;
{--------}
destructor TffDBList.Destroy;
begin
  dblOwner.FFNotifyDependents(ffn_Destroy);

  dblOwner := nil;

  inherited Destroy;
end;
{--------}
procedure TffDBList.dblFreeItem(aItem : TffDBListItem);
begin
  aItem.Free;
end;
{--------}
procedure TffDBList.dblFreeUnownedItems;
var
  Idx    : Integer;
begin
  if Assigned(dblOwner.fcDependentList) then
{Begin !!.11}
    with dblOwner do begin
      fcLock.Lock;
      try
        for Idx := Pred(fcDependentList.Count) downto 0 do
          if TObject(fcDependentList[Idx]) is TffDBListItem then
            with TffDBListItem(fcDependentList[Idx]) do
              if IsOwned then
                DBOwnerName := ''
              else
                dblFreeItem(TffDBListItem(fcDependentList[Idx]));
      finally
        fcLock.Unlock;
      end;
    end;  { with }
{End !!.11}
end;
{--------}
function TffDBList.dblGetCount : Integer;
begin
  with dblOwner do
{Begin !!.11}
    if Assigned(fcDependentList) then begin
      fcLock.Lock;
      try
        Result := fcDependentList.Count;
      finally
        fcLock.Unlock;
      end;
    end
{End !!.11}
    else
      Result := 0;
end;
{--------}
function TffDBList.dblGetItem(aInx : Integer): TffDBListItem;
begin
  Assert(aInx > -1);
  Assert(aInx < Count, Format('%d not < %d', [aInx, Count]));
  with dblOwner do
{Begin !!.11}
    if Assigned(fcDependentList) then begin
      fcLock.Lock;
      try
        Result := TffDBListItem(fcDependentList.Items[aInx].Key^);
      finally
        fcLock.Unlock;
      end;
    end
{End !!.11}
    else
      Result := nil;
end;
{--------}
function TffDBList.FindItem(const aName: string; var aItem: TffDBListItem): Boolean;
var
  Inx    : Integer;
  DBItem : TffDBListItem;
begin
  aItem := nil;
  Result := False;
  if aName <> '' then
    with dblOwner do
{Begin !!.11}
      if Assigned(fcDependentList) then begin
        fcLock.Lock;
        try
          with fcDependentList do
            for Inx := Pred(Count) downto 0 do begin
              DBItem := TffDBListItem(Items[Inx].Key^);
              if (FFAnsiCompareText(DBItem.DBName, aName) = 0) then begin {!!.07}
                aItem := DBItem;
                Result := true;
                Exit;
              end;
            end;
        finally
          fcLock.Unlock;
        end;
      end
{End !!.11}
      else
        Result := False;
end;
{--------}
procedure TffDBList.GetItem(const aName: string; var aItem: TffDBListItem);
begin
  if aName = '' then
    aItem := nil
  else
    if not FindItem(aName, aItem) then
      RaiseFFErrorMsg(ffStrResDataSet[ffdse_MissingItem]);
end;
{--------}
procedure TffDBList.GetItemNames(aList : TStrings);
var
  Inx  : Integer;
  Item : TffDBListItem;
begin
  Assert(Assigned(aList));
  with dblOwner do
{Begin !!.11}
    if Assigned(fcDependentList) then begin
      fcLock.Lock;
      try
        with fcDependentList do begin
          aList.BeginUpdate;
          try
            for Inx := Pred(Count) downto 0 do begin
              Item := TffDBListItem(Items[Inx].Key^);
              if (Item.DBName <> '') then
                aList.Add(Item.DBName);
            end;
          finally
            aList.EndUpdate;
          end;
        end;
      finally
        fcLock.Unlock;
      end;
    end;
{End !!.11}
end;
{--------}
function TffDBList.IndexOfItem(aItem : TffDBListItem) : Integer;
begin
  with dblOwner do
{Begin !!.11}
    if Assigned(fcDependentList) then begin
      fcLock.Lock;
      try
        Result := IndexofItem(@aItem);
      finally
        fcLock.Unlock;
      end;
    end
{End !!.11}
    else
      Result := -1;
end;
{====================================================================}


{===TffDBListItem====================================================}
constructor TffDBListItem.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  dbliOwnedDBItems := dbliCreateOwnedList;
end;
{--------}
destructor TffDBListItem.Destroy;
begin
  FFNotifyDependents(ffn_Destroy);

  dbliSwitchOwnerTo(nil);

  dbliOwnedDBItems.Free;
  dbliOwnedDBItems := nil;

  inherited Destroy;
end;
{--------}
procedure TffDBListItem.CheckActive;
begin
  if not Active then
    dbliMustBeOpenError;
end;
{--------}
procedure TffDBListItem.CheckInactive(const aCanClose : Boolean);

begin
  if Active then
    if aCanClose then
      Close
    else
      dbliMustBeClosedError;
end;
{--------}
procedure TffDBListItem.Close;
begin
  Active := False;
end;
{--------}
procedure TffDBListItem.FFNotificationEx(const AOp : Byte; AFrom : TffComponent;
                                         const AData : TffWord32);
begin
  if (dbliDBOwner = AFrom) then
    case AOp of
      ffn_Destroy,
      ffn_Remove :
        begin
          Close;
          dbliDBOwner := nil;
        end;
      ffn_Deactivate :
        begin
          Close;
        end;
      ffn_OwnerChanged :
        begin
          dbliDBOwnerChanged;
          DBOwnerName := TffDBListItem(AFrom).dbliDBName;
        end;
    end;
end;
{--------}
procedure TffDBListItem.dbliClosePrim;
begin
  FFNotifyDependents(ffn_Deactivate);
end;
{--------}
function TffDBListItem.dbliCreateOwnedList : TffDBList;
begin
  Result := TffDBList.Create(Self);
end;
{--------}
procedure TffDBListItem.dbliDBItemAdded(aItem : TffDBListItem);
begin
  {do nothing}
end;
{--------}
procedure TffDBListItem.dbliDBItemDeleted(aItem : TffDBListItem);
begin
  {do nothing}
end;
{--------}
procedure TffDBListItem.dbliNotifyDBOwnerChanged;
begin
  FFNotifyDependents(ffn_OwnerChanged);
end;
{--------}
procedure TffDBListItem.dbliDBOwnerChanged;
begin
  { do nothing }
end;
{--------}
function TffDBListItem.dbliFindDBOwner(const aName : string) : TffDBListItem;
begin
  {at this level we have no hope of identifying a DB owner}
  Result := nil;
end;
{Begin !!.01}
{--------}
procedure TffDBListItem.dbliFreeTemporaryDependents;
var
  aComp : TffDBListItem;
  aList : TffPointerList;
  Idx,Idx2 : Integer;                                                  {!!.02}
begin
  { Note: Removal of items from dependency list must be separated from
    deactivation of those items otherwise we get a list deadlock. }
  if Assigned(fcDependentList) then begin

    aList := nil;

    { Stage 1: Look for temporary items. }
{Begin !!.11}
    fcLock.Lock;
    try
      for Idx := Pred(fcDependentList.Count) downto 0 do begin
        aComp := TffDBListItem(TffIntListItem(fcDependentList[Idx]).KeyAsInt);
        if aComp.Temporary then begin
          if aList = nil then
            aList := TffPointerList.Create;
          aList.Append(pointer(Idx));
        end;
      end;  { for }
    finally
      fcLock.Unlock;
    end;
{End !!.11}

    { Stage 2: Tell the temporary items to close. Must do this without locking
      the dependency list otherwise we get a deadlock. }
    if aList <> nil then begin
      for Idx := 0 to pred(aList.Count) do begin
        Idx2 := Longint(aList[Idx]);                                   {!!.02}
        aComp := TffDBListItem(TffIntListItem(fcDependentList[Idx2]).KeyAsInt);  {!!.02}
        aComp.Active := False;
      end;

      { Stage 3: Remove the temporary items from the dependency list. }
{Begin !!.11}
      fcLock.Lock;
      try
        for Idx := 0 to pred(aList.Count) do begin
          Idx2 := Longint(aList[Idx]);                               {!!.02}
          aComp := TffDBListItem(TffIntListItem(fcDependentList[Idx2]).KeyAsInt);  {!!.02}
          fcDependentList.DeleteAt(Idx2);                            {!!.02}
          aComp.Free;
        end;
      finally
        fcLock.Unlock;
      end;
{End !!.11}
      aList.Free;
    end; { if aList <> nil }
  end;

end;
{End !!.01}
{--------}
function TffDBListItem.dbliGetDBOwner : TffDBListItem;
begin
  if (dbliDBOwner = nil) then
    DBOwner := dbliFindDBOwner(dbliDBOwnerName);
  Result := dbliDBOwner;
end;
{--------}
function TffDBListItem.dbliGetDBOwnerName : string;
begin
  if (dbliDBOwner <> nil) then begin
    dbliDBOwnerName := dbliDBOwner.DBName;
    Result := dbliDBOwnerName;
  end else begin
    DBOwner := dbliFindDBOwner(dbliDBOwnerName);
    if (dbliDBOwner = nil) then
      Result := dbliDBOwnerName
    else {DB owner exists} begin
      dbliDBOwnerName := dbliDBOwner.DBName;
      Result := dbliDBOwnerName;
    end;
  end;
end;
{--------}
function TffDBListItem.dbliGetOwned : Boolean;
begin
  Result := Assigned(Owner);
end;
{--------}
procedure TffDBListItem.dbliLoaded;
begin
  try
    if dbliMakeActive then begin
      {if we need a DB owner, resolve our DB owner name to an object}
      if not NeedsNoOwner then
        DBOwner := dbliResolveDBOwner(dbliDBOwnerName);
      {if we don't need a DB owner or our DB owner has managed to
       become active, make ourselves active}
      if NeedsNoOwner or not (DBOwner.LoadActiveFailed) then begin
        dbliFailedActive := true;
        Active := true;
        dbliMakeActive := false;
        dbliFailedActive := false;
      end;
    end else
      if (dbliDBOwnerName <> '') then
        dbliGetDBOwner;
  except
    if (csDesigning in ComponentState) then
      Application.HandleException(Self)
    else
      raise;
  end;{try..except}
end;
{--------}
procedure TffDBListItem.dbliMustBeClosedError;
begin
  RaiseFFErrorObj(Self, ffdse_MustBeClosed);
end;
{--------}
procedure TffDBListItem.dbliMustBeOpenError;
begin
  RaiseFFErrorObj(Self, ffdse_MustBeOpen);
end;
{--------}
procedure TffDBListItem.dbliOpenPrim;
begin
  {do nothing at this level}
end;
{--------}
function TffDBListItem.dbliResolveDBOwner(const aName : string) : TffDBListItem;
begin
  Result := dbliFindDBOwner(aName);
  if (Result = nil) then
    if not NeedsNoOwner then
      RaiseFFErrorObjFmt(Self, ffdse_MissingOwner, [Self.ClassName, Self.DBName]);
end;
{--------}
procedure TffDBListItem.dbliSetActive(const aValue: Boolean);
begin
  if aValue <> dbliActive then
    if (csReading in ComponentState) or LoadingFromStream then begin
      if aValue then
        dbliMakeActive := true;
      AddToFixupList(Self);
    end else begin
      {if we're making ourselves active...}
      if aValue then begin
        {if we haven't actually become active yet...}
        if not dbliActive then begin
          {we need a name}
          if (DBName = '') then
            RaiseFFErrorObjFmt(Self, ffdse_NeedsName, [dbliReqPropName]);
          {if we need a DB owner...}
          if not NeedsNoOwner then begin
            {make sure we have a DB owner name}
            if (DBOwnerName = '') then
              RaiseFFErrorObj(Self, ffdse_NeedsOwnerName);
            {make sure we have a DB owner object}
            if (dbliDBOwner = nil) then
              DBOwner := dbliResolveDBOwner(dbliDBOwnerName);
            {make sure our DB owner is open}
            if not DBOwner.Active then
              DBOwner.Active := true;
          end;
          {now we open ourselves}
          dbliOpenPrim;
        end;
        dbliActive := True;
      end else {closing} begin
        dbliClosePrim;
        dbliActive := False;
      end;
    end;
end;
{--------}
procedure TffDBListItem.dbliSetDBName(const aName: string);
begin
  CheckInactive(True);
  dbliDBName := aName;
end;
{--------}
procedure TffDBListItem.dbliSetDBOwner(const aDBOwner : TffDBListItem);
begin
  if (aDBOwner = nil) and (dbliDBOwner = nil) then
    Exit;
  CheckInactive(True);
  dbliSwitchOwnerTo(aDBOwner);
  dbliNotifyDBOwnerChanged;
end;
{--------}
procedure TffDBListItem.dbliSetDBOwnerName(const aName: string);
begin
  if (csReading in ComponentState) or LoadingFromStream then begin
    dbliDBOwnerName := aName;
    AddToFixupList(Self);
  end else
    if (FFAnsiCompareText(dbliDBOwnerName, aName) <> 0) then begin    {!!.07}
      CheckInactive(true);
      {set our DB owner to nil}
      dbliSwitchOwnerTo(nil);
      {save our new DB owner name}
      dbliDBOwnerName := aName;
      dbliNotifyDBOwnerChanged;
    end;
end;
{--------}
procedure TffDBListItem.dbliSwitchOwnerTo(const aDBOwner : TffDBListItem);
begin
  if (dbliDBOwner <> nil) then begin
    dbliDBOwner.FFRemoveDependent(Self);
  end;
  dbliDBOwner := aDBOwner;
  if (dbliDBOwner = nil) then
    dbliDBOwnerName := ''
  else begin
    dbliDBOwner.FFAddDependent(Self);
    dbliDBOwnerName := dbliDBOwner.DBName;
  end;
end;
{--------}
procedure TffDBListItem.ForceClosed;
begin
  Close;
end;
{--------}
procedure TffDBListItem.Loaded;
begin
  inherited Loaded;
  ApplyFixupList;
  LoadingFromStream := False;
end;
{--------}
procedure TffDBListItem.Open;
begin
  Active := True;
end;
{====================================================================}


{===TffDBStandaloneList========================================================}
constructor TffDBStandaloneList.Create;
begin
  inherited Create;
  dblList := TffThreadList.Create;
end;
{--------}
destructor TffDBStandaloneList.Destroy;
begin
  if Assigned(dblList) then
    with dblList.BeginWrite do
      try
        dblCloseAllItems;
      finally
        EndWrite;
      end;

  dblList.Free;
  dblList := nil;

  inherited Destroy;
end;
{--------}
procedure TffDBStandaloneList.AddItem(aItem: TffDBListItem);
begin
  Assert(Assigned(dblList));
  with dblList.BeginWrite do
    try
      Insert(TffIntListItem.Create(Longint(aItem)));
    finally
      EndWrite;
    end;
end;
{--------}
procedure TffDBStandaloneList.dblCloseAllItems;
var
  Inx  : integer;
  Item : TffDBListItem;
begin
  for Inx := pred(dblList.Count) downto 0 do begin
    Item := Items[Inx];
    {note: item opens are reference counted, so we need to force the
           item closed}
    Item.Close;
  end;
end;
{--------}
procedure TffDBStandaloneList.dblFreeItem(aItem : TffDBListItem);
begin
  aItem.Free;
end;
{--------}
procedure TffDBStandaloneList.dblFreeUnownedItems;
var
  Inx    : integer;
  DBItem : TffDBListItem;
begin
  for Inx := pred(dblList.Count) downto 0 do begin
    DBItem := Items[Inx];
    if DBItem.IsOwned then
      DBItem.DBOwnerName := ''
    else
      dblFreeItem(DBItem);
  end;
end;
{--------}
function TffDBStandaloneList.dblGetCount: integer;
begin
  with dblList.BeginRead do
    try
      Result := Count;
    finally
      EndRead;
    end;
end;
{--------}
function TffDBStandaloneList.dblGetItem(aInx: integer): TffDBListItem;
begin
  with dblList.BeginRead do
    try
      Result := TffDBListItem(dblList[aInx].Key^);
    finally
      EndRead;
    end;
end;
{--------}
procedure TffDBStandaloneList.DeleteItem(aItem: TffDBListItem);
var
  Inx : integer;
begin
  with dblList.BeginWrite do
    try
      Inx := dblList.Index(Longint(aItem));
      if (Inx <> -1) then
        dblList.Delete(Longint(aItem));
    finally
      EndWrite;
    end;
end;
{--------}
function TffDBStandaloneList.FindItem(const aName: string; var aItem: TffDBListItem): boolean;
var
  Inx    : integer;
  DBItem : TffDBListItem;
begin
  with dblList.BeginRead do
    try
      for Inx := Pred(Count) downto 0 do begin
        DBItem := TffDBListItem(Items[Inx].Key^);
        if (FFAnsiCompareText(DBItem.DBName, aName) = 0) then begin   {!!.07}
          aItem := DBItem;
          Result := true;
          Exit;
        end;
      end;
      aItem := nil;
      Result := false;
    finally
      EndRead;
    end;
end;
{--------}
procedure TffDBStandaloneList.GetItem(const aName: string; var aItem: TffDBListItem);
begin
  with dblList.BeginRead do
    try
      if not FindItem(aName, aItem) then
        RaiseFFErrorMsg(ffStrResDataSet[ffdse_MissingItem]);
    finally
      EndRead;
    end;
end;
{--------}
procedure TffDBStandaloneList.GetItemNames(aList: TStrings);
var
  Inx : integer;
  Item: TffDBListItem;
begin
  with dblList.BeginRead do
    try
      aList.BeginUpdate;
      try
        for Inx := pred(dblList.Count) downto 0 do begin
          Item := TffDBListItem(Items[Inx].Key^);
          if (Item.DBName <> '') then
            aList.Add(Item.DBName);
        end;
      finally
        aList.EndUpdate;
      end;{try..finally}
    finally
      EndRead;
    end;
end;
{--------}
function TffDBStandaloneList.IndexOfItem(aItem : TffDBListItem) : integer;
begin
  with dblList.BeginRead do
    try
      Result := IndexOfItem(@aItem)
    finally
      EndRead;
    end;
end;
{Begin !!.02}
{--------}
procedure TffDBStandaloneList.BeginRead;
begin
  dblList.BeginRead;
end;
{--------}
procedure TffDBStandaloneList.BeginWrite;
begin
  dblList.BeginWrite;
end;
{--------}
procedure TffDBStandaloneList.EndRead;
begin
  dblList.EndRead;
end;
{--------}
procedure TffDBStandaloneList.EndWrite;
begin
  dblList.EndWrite;
end;
{End !!.02}
{====================================================================}

procedure FinalizeUnit;
begin
  ffStrResDataSet.Free;
end;

procedure InitializeUnit;
begin
  ffStrResDataSet := nil;
  ffStrResDataSet := TffStringResource.Create(hInstance, 'FF_DATASET_ERROR_STRINGS');
end;

initialization
  InitializeUnit;

finalization
  FinalizeUnit;

end.