まず"シングルトンもどき"です。
unit Unit4;
interface
type
TSingleton = class(TObject)
private
FTestValue: Integer;
public
class constructor Create;
class destructor Destroy;
constructor Create;
destructor Destroy; override;
property TestValue: Integer
read FTestValue
write FTestValue;
end;
function Singleton: TSingleton;
implementation
var
FSingleton: TSingleton;
function Singleton: TSingleton;
begin
if FSingleton = nil then
begin
FSingleton := TSingleton.Create;
end;
Result := FSingleton;
end;
class constructor TSingleton.Create;
begin
FSingleton := nil;
end;
class destructor TSingleton.Destroy;
begin
FSingleton.Free;
end;
constructor TSingleton.Create;
begin
inherited;
{ Initialize }
FTestValue := 0;
end;
destructor TSingleton.Destroy;
begin
{ Finalize }
inherited;
end;
end.
unit Unit8;
interface
uses
SysUtils;
type
TSingleton = class(TObject)
private
FTestValue: Integer;
class var
FSingleton: TSingleton;
constructor CreateInstance;
public
class constructor Create;
class destructor Destroy;
constructor Create;
destructor Destroy; override;
class function GetInstance: TSingleton;
property TestValue: Integer
read FTestValue
write FTestValue;
end;
ECreateSingleton = class(Exception)
end;
implementation
{ TSingleton }
class constructor TSingleton.Create;
begin
FSingleton := nil;
end;
class destructor TSingleton.Destroy;
begin
FSingleton.Free;
end;
constructor TSingleton.Create;
begin
raise ECreateSingleton.Create('TSingleton.Create cannot use.');
end;
constructor TSingleton.CreateInstance;
begin
inherited Create;
{ Initialize }
FTestValue := 0;
end;
destructor TSingleton.Destroy;
begin
{ Finalize }
inherited;
end;
class function TSingleton.GetInstance: TSingleton;
begin
if FSingleton = nil then
begin
FSingleton := TSingleton.CreateInstance;
end;
Result := FSingleton;
end;
end.
unit Unit12;
interface
uses
SysUtils, Windows;
type
TSingleton = class(TObject)
private
FTestValue: Integer;
class var
FSingleton: TSingleton;
FCriticalSection: TRTLCriticalSection;
constructor CreateInstance;
public
class constructor Create;
class destructor Destroy;
constructor Create;
destructor Destroy; override;
class function GetInstance: TSingleton;
property TestValue: Integer
read FTestValue
write FTestValue;
end;
ECreateSingleton = class(Exception)
end;
implementation
{ TSingleton }
type
TInitializeCriticalSectionExFunc = function(var lpCriticalSection: TRTLCriticalSection;
dwSpinCount: DWORD;
Flags: DWORD): BOOL; stdcall;
const
CRITICAL_SECTION_NO_DEBUG_INFO = $01000000;
class constructor TSingleton.Create;
var
InitializeCriticalSectionEx: TInitializeCriticalSectionExFunc;
begin
FSingleton := nil;
@InitializeCriticalSectionEx := GetProcAddress(GetModuleHandle(kernel32),
'InitializeCriticalSectionEx');
if Assigned(InitializeCriticalSectionEx) = True then
begin
InitializeCriticalSectionEx(FCriticalSection,0,CRITICAL_SECTION_NO_DEBUG_INFO);
end
else
begin
InitializeCriticalSectionAndSpinCount(FCriticalSection,0);
end;
end;
class destructor TSingleton.Destroy;
begin
DeleteCriticalSection(FCriticalSection);
FSingleton.Free;
end;
constructor TSingleton.Create;
begin
raise ECreateSingleton.Create('TSingleton.Create cannot use.');
end;
constructor TSingleton.CreateInstance;
begin
inherited Create;
{ Initialize }
FTestValue := 0;
end;
destructor TSingleton.Destroy;
begin
{ Finalize }
inherited;
end;
class function TSingleton.GetInstance: TSingleton;
begin
EnterCriticalSection(FCriticalSection);
try
if FSingleton = nil then
begin
FSingleton := TSingleton.CreateInstance;
end;
finally
LeaveCriticalSection(FCriticalSection);
end;
Result := FSingleton;
end;
end.
unit Unit16;
interface
uses
SysUtils, Windows;
type
TSingleton = class(TObject)
private
FTestValue: Integer;
class var
FSingleton: TSingleton;
constructor CreateInstance;
public
class constructor Create;
class destructor Destroy;
constructor Create;
destructor Destroy; override;
class function GetInstance: TSingleton;
property TestValue: Integer
read FTestValue
write FTestValue;
end;
ECreateSingleton = class(Exception)
end;
implementation
{ TSingleton }
class constructor TSingleton.Create;
begin
FSingleton := TSingleton.CreateInstance;
end;
class destructor TSingleton.Destroy;
begin
FSingleton.Free;
end;
constructor TSingleton.Create;
begin
raise ECreateSingleton.Create('TSingleton.Create cannot use.');
end;
constructor TSingleton.CreateInstance;
begin
inherited Create;
{ Initialize }
FTestValue := 0;
end;
destructor TSingleton.Destroy;
begin
{ Finalize }
inherited;
end;
class function TSingleton.GetInstance: TSingleton;
begin
Result := FSingleton;
end;
end.
