2015-12-22 12:38:17 +01:00
|
|
|
{***************************************************************************}
|
|
|
|
{ }
|
2015-12-29 17:57:04 +01:00
|
|
|
{ Delphi MVC Framework }
|
2015-12-22 12:38:17 +01:00
|
|
|
{ }
|
2015-12-29 17:57:04 +01:00
|
|
|
{ Copyright (c) 2010-2015 Daniele Teti and the DMVCFramework Team }
|
2015-12-22 12:38:17 +01:00
|
|
|
{ }
|
|
|
|
{ https://github.com/danieleteti/delphimvcframework }
|
|
|
|
{ }
|
|
|
|
{***************************************************************************}
|
|
|
|
{ }
|
|
|
|
{ Licensed under the Apache License, Version 2.0 (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.apache.org/licenses/LICENSE-2.0 }
|
|
|
|
{ }
|
|
|
|
{ Unless required by applicable law or agreed to in writing, software }
|
|
|
|
{ distributed under the License is distributed on an "AS IS" BASIS, }
|
|
|
|
{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
|
|
|
|
{ See the License for the specific language governing permissions and }
|
|
|
|
{ limitations under the License. }
|
|
|
|
{ }
|
|
|
|
{***************************************************************************}
|
|
|
|
|
2013-10-30 00:48:23 +01:00
|
|
|
unit MVCFramework.ApplicationSession;
|
|
|
|
|
|
|
|
interface
|
|
|
|
|
|
|
|
uses System.SysUtils, System.Generics.Collections;
|
|
|
|
|
|
|
|
type
|
|
|
|
TWebApplicationSession = class abstract
|
|
|
|
strict protected
|
|
|
|
function GetItems(const Key: string): string; virtual; abstract;
|
|
|
|
procedure SetItems(const Key, Value: string); virtual; abstract;
|
|
|
|
|
|
|
|
public
|
|
|
|
constructor Create; virtual;
|
|
|
|
destructor Destroy; override;
|
|
|
|
function ToString: string; override;
|
|
|
|
property Items[const Key: string]: string read GetItems
|
|
|
|
write SetItems; default;
|
|
|
|
end;
|
|
|
|
|
|
|
|
TWebApplicationSessionClass = class of TWebApplicationSession;
|
|
|
|
|
|
|
|
TWebApplicationSessionMemory = class(TWebApplicationSession)
|
|
|
|
strict protected
|
|
|
|
FData: TDictionary<string, string>;
|
|
|
|
function GetItems(const Key: String): String; override;
|
|
|
|
procedure SetItems(const Key, Value: String); override;
|
|
|
|
|
|
|
|
public
|
|
|
|
function ToString: String; override;
|
|
|
|
constructor Create; override;
|
|
|
|
destructor Destroy; override;
|
|
|
|
end;
|
|
|
|
|
|
|
|
TMVCApplicationSessionFactory = class sealed
|
|
|
|
protected
|
|
|
|
FRegisteredApplicationSessionTypes: TDictionary<String, TWebApplicationSessionClass>;
|
|
|
|
class var FInstance: TMVCApplicationSessionFactory;
|
|
|
|
constructor Create;
|
|
|
|
public
|
|
|
|
procedure RegisterSessionType(AName: String; AWebApplicationSessionClass: TWebApplicationSessionClass);
|
|
|
|
class function GetInstance: TMVCApplicationSessionFactory;
|
|
|
|
function CreateNewByType(AName: String): TWebApplicationSession;
|
2015-04-01 17:01:23 +02:00
|
|
|
destructor Destroy; override;
|
2013-10-30 00:48:23 +01:00
|
|
|
end;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
|
|
|
|
uses
|
|
|
|
System.dateutils;
|
|
|
|
|
|
|
|
constructor TWebApplicationSession.Create;
|
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
end;
|
|
|
|
|
|
|
|
destructor TWebApplicationSession.Destroy;
|
|
|
|
begin
|
|
|
|
inherited;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWebApplicationSession.ToString: string;
|
|
|
|
begin
|
|
|
|
Result := '';
|
|
|
|
end;
|
|
|
|
|
|
|
|
constructor TWebApplicationSessionMemory.Create;
|
|
|
|
begin
|
|
|
|
inherited;
|
|
|
|
FData := TDictionary<string, string>.Create;
|
|
|
|
end;
|
|
|
|
|
|
|
|
destructor TWebApplicationSessionMemory.Destroy;
|
|
|
|
begin
|
|
|
|
FData.Free;
|
|
|
|
inherited;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWebApplicationSessionMemory.GetItems(const Key: String): String;
|
|
|
|
begin
|
|
|
|
TMonitor.Enter(self);
|
|
|
|
try
|
|
|
|
if not FData.TryGetValue(Key, Result) then
|
|
|
|
Result := '';
|
|
|
|
finally
|
|
|
|
TMonitor.Exit(self);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TWebApplicationSessionMemory.SetItems(const Key, Value: String);
|
|
|
|
begin
|
|
|
|
TMonitor.Enter(self);
|
|
|
|
try
|
|
|
|
FData.AddOrSetValue(Key, Value);
|
|
|
|
finally
|
|
|
|
TMonitor.Exit(self);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWebApplicationSessionMemory.ToString: String;
|
|
|
|
var
|
|
|
|
Key: String;
|
|
|
|
begin
|
|
|
|
TMonitor.Enter(self);
|
|
|
|
try
|
|
|
|
Result := '';
|
|
|
|
for Key in FData.Keys do
|
|
|
|
begin
|
|
|
|
Result := Key + ' = ' + QuotedStr(FData.Items[Key]) + sLineBreak;
|
|
|
|
end;
|
|
|
|
finally
|
|
|
|
TMonitor.Exit(self);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
{ TMVCSessionManager }
|
|
|
|
|
|
|
|
constructor TMVCApplicationSessionFactory.Create;
|
|
|
|
begin
|
|
|
|
inherited;
|
|
|
|
FRegisteredApplicationSessionTypes := TDictionary<string, TWebApplicationSessionClass>.Create;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TMVCApplicationSessionFactory.CreateNewByType(AName: String): TWebApplicationSession;
|
|
|
|
var
|
|
|
|
clazz: TWebApplicationSessionClass;
|
|
|
|
begin
|
|
|
|
if not FRegisteredApplicationSessionTypes.TryGetValue(AName, clazz) then
|
|
|
|
raise Exception.Create('Unknown application session type');
|
|
|
|
Result := clazz.Create;
|
|
|
|
end;
|
|
|
|
|
|
|
|
destructor TMVCApplicationSessionFactory.Destroy;
|
|
|
|
begin
|
|
|
|
FRegisteredApplicationSessionTypes.Free;
|
|
|
|
inherited;
|
|
|
|
end;
|
|
|
|
|
|
|
|
class
|
|
|
|
function TMVCApplicationSessionFactory.GetInstance: TMVCApplicationSessionFactory;
|
|
|
|
begin
|
|
|
|
if not Assigned(FInstance) then // doesnt require double-check because used for the first time at the unit initialization
|
|
|
|
FInstance := TMVCApplicationSessionFactory.Create;
|
|
|
|
Result := FInstance;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TMVCApplicationSessionFactory.RegisterSessionType(AName: String;
|
|
|
|
AWebApplicationSessionClass: TWebApplicationSessionClass);
|
|
|
|
begin
|
|
|
|
FRegisteredApplicationSessionTypes.AddOrSetValue(AName, AWebApplicationSessionClass);
|
|
|
|
end;
|
|
|
|
|
|
|
|
initialization
|
|
|
|
|
|
|
|
TMVCApplicationSessionFactory.GetInstance.RegisterSessionType('memory', TWebApplicationSessionMemory);
|
|
|
|
|
|
|
|
finalization
|
|
|
|
|
|
|
|
TMVCApplicationSessionFactory.FInstance.Free;
|
|
|
|
|
|
|
|
end.
|