pfgbaseclasses.pas

delphi编写与Palm数据交换管道连接程序。

unit pfgBaseClasses;
{**************************************************************************}
{* pfgBaseClasses Unit                                                    *}
{*                                                                        *}
{* Contains a set of basic generic classes and miscellaneous methods      *}
{*                                                                        *}
{* Copyright (C) 2000-2002 by Paul Gilbert, All Rights Reserved           *}
{**************************************************************************}

interface

uses Classes, SysUtils;

type
  //
  // TpfgSingletonComponent
  // Provides a base class for singletons - classes that can only have one
  // instance. Internally, it maintains a global list of the class name of
  // all instances of classes derived from this base class, and raises an
  // exception if one is instantiated more than once
    
  TpfgSingletonComponent = class(TComponent)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    class function GetInstance: TpfgSingletonComponent;
  end;

  EpfgSingletonError = class(Exception);

resourcestring
  SMultipleInstanceError = 'The class "%s" has already been instantiated';
  SSingletonNotFoundError = 'The singleton derived class was not found';

  SConversionError = 'The specified version string was invalid';
  SCreatorIDError = 'The Creator ID must be four characters long';
  SPriorityError = 'The priority must be in the range 0 to 4';

implementation

var
  ClassList: TStringList = nil; // Contains the instantiated singleton classes

{**************************************************************************}
{* TpfgSingletonComponent class                                           *}
{*                                                                        *}
{**************************************************************************}

constructor TpfgSingletonComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  // Create a class list if it hasn't already been created
  if not Assigned(ClassList) then ClassList := TStringList.Create;

  // Only check for multiple instances if it is runtime (ie. not design time)
  if not (csDesigning in ComponentState) then
  begin
    // Check whether the final derived class is already instantiated
    if ClassList.IndexOf(Self.ClassName) <> -1 then
      raise EpfgSingletonError.CreateFmt(SMultipleInstanceError, [Self.ClassName]);

    // Store a copy of this instance of the component
    ClassList.AddObject(Self.ClassName, Self);
  end;
end;

destructor TpfgSingletonComponent.Destroy;
var
  ctr: Integer;
begin
  // Note: We scan through the list for this specific instance - we can't use
  // the classname itself, because if a second instance is created, then the
  // destructor would remove the entry for the first when destructing the second
  for ctr := 0 to ClassList.Count-1 do
    if ClassList.Objects[ctr] = Self then
    begin
      ClassList.Delete(ctr);
      Break;
    end;

  inherited Destroy;
end;

// GetInstance
// Provides a convient method for grabbing a reference to an instantiated
// singleton class.

class function TpfgSingletonComponent.GetInstance: TpfgSingletonComponent;
var
  Index: Integer;
begin
  // Search for an instance
  if not Assigned(ClassList) then
    Result := nil
  else
  begin
    Index := ClassList.IndexOf(ClassName);
    if Index = -1 then
      Result := nil
    else
      Result := ClassList.Objects[Index] as TpfgSingletonComponent;
  end;
end;


initialization

finalization
begin
  if Assigned(ClassList) then ClassList.Free;
end;

end.