david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
515 lines
18 KiB
ObjectPascal
515 lines
18 KiB
ObjectPascal
unit uRODBSessionManager;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Provided by Niko Schoemaker (niko.schoemaker@teamro.remobjects.com) }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I RemObjects.inc}
|
|
|
|
interface
|
|
|
|
uses Classes, uROSessions, DB;
|
|
|
|
type
|
|
TConvertGUIDEvent = function(Sender: TROCustomSessionManager; const aGUID: TGUID): string of object;
|
|
TRODBSessionManagerDatasetGetParams = function(Sender: TROCustomSessionManager; aDataset: TDataset): TParams of object;
|
|
TRODBSessionManagerDatasetSetParams = procedure(Sender: TROCustomSessionManager; aDataset: TDataset; aParams: TParams) of object;
|
|
TRODBSessionManagerDatasetExecute = procedure(Sender: TROCustomSessionManager; aDataset: TDataset) of object;
|
|
|
|
{$IFDEF FPC}
|
|
IProviderSupport = interface
|
|
procedure PSExecute;
|
|
function PSGetParams: TParams;
|
|
procedure PSSetParams(AParams: TParams);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TRODBSessionManager }
|
|
TRODBSessionManager = class(TROCustomSessionManager)
|
|
private
|
|
fInsertDataset,
|
|
fDeleteDataset,
|
|
fUpdateDataset,
|
|
fSelectDataset,
|
|
fGetCountDataset,
|
|
fClearSessionsDataset,
|
|
fSelectAllDataset : TDataset;
|
|
|
|
fFieldNameSessionID,
|
|
fFieldNameCreated,
|
|
fFieldNameLastAccessed,
|
|
fFieldNameData: string;
|
|
fClearSessionsOnDestroy: boolean;
|
|
fClearSessionsOnCreate: boolean;
|
|
fOnConvertGUID: TConvertGUIDEvent;
|
|
fOnDatasetExecute: TRODBSessionManagerDatasetExecute;
|
|
fOnDatasetGetParams: TRODBSessionManagerDatasetGetParams;
|
|
fOnDatasetSetParams: TRODBSessionManagerDatasetSetParams;
|
|
|
|
function GetProvider(aDataset: TDataset): IProviderSupport;
|
|
procedure SetClearSessionsDataset(const Value: TDataset);
|
|
procedure SetDeleteDataset(const Value: TDataset);
|
|
procedure SetGetCountDataset(const Value: TDataset);
|
|
procedure SetInsertDataset(const Value: TDataset);
|
|
procedure SetSelectDataset(const Value: TDataset);
|
|
procedure SetUpdateDataset(const Value: TDataset);
|
|
procedure SetSelectAllDataset(const Value: TDataSet);
|
|
function DoDatasetGetParams(aDataset: TDataset; aProvider: IProviderSupport): TParams;
|
|
procedure DoDatasetSetParams(aDataset: TDataset; aProvider: IProviderSupport; AParams: TParams);
|
|
procedure DoDatasetExecute(aDataset: TDataset; aProvider: IProviderSupport);
|
|
protected
|
|
// TROCustomSessionManager
|
|
function DoFindSession(const aSessionID : TGUID; aUpdateTime: Boolean) : TROSession; override;
|
|
procedure DoDeleteSession(const aSessionID : TGUID; IsExpired : boolean); override;
|
|
procedure DoClearSessions(OnlyExpired : boolean); override;
|
|
function DoGetSessionCount : integer; override;
|
|
procedure DoReleaseSession(aSession : TROSession; NewSession : boolean); override;
|
|
procedure DoGetAllSessions(Dest: TStringList); override;
|
|
|
|
function DoConvertGUID(const aGUID: TGUID): string; virtual;
|
|
// Internals
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Loaded; override;
|
|
|
|
public
|
|
constructor Create(aOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure CheckProperties; override;
|
|
published
|
|
property FieldNameSessionID : string read fFieldNameSessionID write fFieldNameSessionID;
|
|
property FieldNameCreated : string read fFieldNameCreated write fFieldNameCreated;
|
|
property FieldNameLastAccessed : string read fFieldNameLastAccessed write fFieldNameLastAccessed;
|
|
property FieldNameData : string read fFieldNameData write fFieldNameData;
|
|
|
|
property InsertDataset : TDataset read fInsertDataset write SetInsertDataset;
|
|
property DeleteDataset : TDataset read fDeleteDataset write SetDeleteDataset;
|
|
property UpdateDataset : TDataset read fUpdateDataset write SetUpdateDataset;
|
|
property SelectDataset : TDataset read fSelectDataset write SetSelectDataset;
|
|
property GetCountDataset : TDataset read fGetCountDataset write SetGetCountDataset;
|
|
{$WARNINGS OFF}
|
|
property ClearSessionsDataset : TDataset read fClearSessionsDataset write SetClearSessionsDataset;
|
|
{$WARNINGS ON}
|
|
property SelectAllDataset : TDataSet read fSelectAllDataset write SetSelectAllDataset;
|
|
|
|
property ClearSessionsOnCreate : boolean read fClearSessionsOnCreate write fClearSessionsOnCreate default true;
|
|
property ClearSessionsOnDestroy : boolean read fClearSessionsOnDestroy write fClearSessionsOnDestroy default true;
|
|
property OnConvertGUID: TConvertGUIDEvent read fOnConvertGUID write fOnConvertGUID;
|
|
property SessionDuration;
|
|
property SessionCheckInterval;
|
|
property OnDatasetGetParams: TRODBSessionManagerDatasetGetParams read fOnDatasetGetParams write fOnDatasetGetParams;
|
|
property OnDatasetSetParams: TRODBSessionManagerDatasetSetParams read fOnDatasetSetParams write fOnDatasetSetParams;
|
|
property OnDatasetExecute : TRODBSessionManagerDatasetExecute read fOnDatasetExecute write fOnDatasetExecute;
|
|
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DELPHI5}ComObj,{$ENDIF}
|
|
SysUtils, {$IFNDEF FPC}SqlTimSt,{$ENDIF} uROClasses;
|
|
|
|
{ TRODBSessionManager }
|
|
|
|
constructor TRODBSessionManager.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
fClearSessionsOnDestroy := TRUE;
|
|
ClearSessionsOnCreate := TRUE;
|
|
|
|
fFieldNameSessionID := 'SessionID';
|
|
fFieldNameCreated := 'Created';
|
|
fFieldNameLastAccessed := 'LastAccessed';
|
|
fFieldNameData := 'Data';
|
|
end;
|
|
|
|
destructor TRODBSessionManager.Destroy;
|
|
begin
|
|
InsertDataset := nil;
|
|
DeleteDataset := nil;
|
|
UpdateDataset := nil;
|
|
SelectDataset := nil;
|
|
GetCountDataset := nil;
|
|
ClearSessionsDataset := nil;
|
|
inherited;
|
|
end;
|
|
|
|
function TRODBSessionManager.GetProvider(aDataset : TDataset) : IProviderSupport;
|
|
begin
|
|
{$IFDEF FPC}
|
|
if aDataset = nil then Result := nil else // prevent FPC warning
|
|
Result := nil;
|
|
{$ELSE}
|
|
{$IFDEF DELPHI7UP}
|
|
result := aDataset as IProviderSupport;
|
|
{$ELSE}
|
|
result := IProviderSupport(aDataset);
|
|
{$ENDIF}
|
|
{$ENDIF FPC}
|
|
end;
|
|
|
|
procedure TRODBSessionManager.DoClearSessions(OnlyExpired: boolean);
|
|
const HoursPerDay = 24;
|
|
MinsPerDay = HoursPerDay * 60;
|
|
var
|
|
params, lparams : TParams;
|
|
provider : IProviderSupport;
|
|
lLastAccessed: TDateTime;
|
|
lFieldNameSessionID: integer;
|
|
lLastAccessIndex: integer;
|
|
begin
|
|
CheckProperties;
|
|
if OnlyExpired then
|
|
lLastAccessed := ((Now*MinsPerDay) - SessionDuration) / MinsPerDay
|
|
else
|
|
lLastAccessed := Now+30; // 30 days from now. Enough to say all! <G>
|
|
if Assigned(OnBeforeDeleteSession) then begin
|
|
fSelectAllDataset.Open;
|
|
lFieldNameSessionID:= fSelectAllDataset.FieldByName(FieldNameSessionID).Index;
|
|
lLastAccessIndex:= fSelectAllDataset.FieldByName(FieldNameLastAccessed).Index;
|
|
try
|
|
fSelectAllDataset.First;
|
|
while not fSelectAllDataset.Eof do try
|
|
if fSelectAllDataset.Fields[lLastAccessIndex].AsDateTime <= lLastAccessed then
|
|
DeleteSession(StringToGUID(fSelectAllDataset.Fields[lFieldNameSessionID].AsString),OnlyExpired);
|
|
finally
|
|
fSelectAllDataset.Next;
|
|
end;
|
|
finally
|
|
fSelectAllDataset.Close;
|
|
end;
|
|
end
|
|
else begin
|
|
provider := GetProvider(fClearSessionsDataset);
|
|
params := DoDatasetGetParams(fClearSessionsDataset,provider);
|
|
lparams:= TParams.Create;
|
|
try
|
|
lparams.Assign(params);
|
|
with lparams.ParamByName(fFieldNameLastAccessed) do
|
|
{$IFNDEF FPC}
|
|
if DataType = ftTimeStamp then
|
|
AsSQLTimeStamp := DateTimeToSQLTimeStamp(lLastAccessed)
|
|
else
|
|
{$ENDIF}
|
|
AsDateTime := lLastAccessed;
|
|
DoDatasetSetParams(fClearSessionsDataset,provider,lparams);
|
|
finally
|
|
lparams.Free;
|
|
end;
|
|
DoDatasetExecute(fClearSessionsDataset,provider);
|
|
provider := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODBSessionManager.DoDeleteSession(const aSessionID: TGUID;
|
|
IsExpired: boolean);
|
|
var params,lParams : TParams;
|
|
provider : IProviderSupport;
|
|
begin
|
|
CheckProperties;
|
|
provider := GetProvider(fDeleteDataset);
|
|
params := DoDatasetGetParams(fDeleteDataset, provider);
|
|
|
|
lParams:=TParams.Create;
|
|
try
|
|
lParams.Assign(Params);
|
|
lparams.ParamByName(fFieldNameSessionID).Value := DoConvertGUID(aSessionID);
|
|
DoDatasetSetParams(fDeleteDataset, provider, lParams);
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
DoDatasetExecute(fDeleteDataset, provider);
|
|
provider := nil;
|
|
end;
|
|
|
|
function TRODBSessionManager.DoFindSession(const aSessionID: TGUID; aUpdateTime: Boolean): TROSession;
|
|
var params,lParams : TParams;
|
|
data : TStream;
|
|
datafld : TBlobField;
|
|
provider : IProviderSupport;
|
|
begin
|
|
CheckProperties;
|
|
result := NIL;
|
|
provider := GetProvider(fSelectDataset);
|
|
|
|
params := DoDatasetGetParams(fSelectDataset, provider);
|
|
lParams:=TParams.Create;
|
|
try
|
|
lParams.Assign(params);
|
|
lparams.ParamByName(fFieldNameSessionID).Value := DoConvertGUID(aSessionID);
|
|
DoDatasetSetParams(fSelectDataset, provider, lParams);
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
provider:=nil;
|
|
|
|
data := nil;
|
|
fSelectDataset.Open;
|
|
try
|
|
if (fSelectDataset.bof and fSelectDataset.eof) then Exit;
|
|
data := TMemoryStream.Create;
|
|
|
|
//result := TROSession.Create(aSessionID);
|
|
result := DoCreateSession(aSessionID);
|
|
result.Created := fSelectDataset.FieldByName(fFieldNameCreated).AsDateTime;
|
|
result.LastAccessed := fSelectDataset.FieldByName(fFieldNameLastAccessed).AsDateTime;
|
|
|
|
datafld := TBlobField(fSelectDataset.FieldByName(fFieldNameData));
|
|
datafld.SaveToStream(data);
|
|
data.Position := 0;
|
|
result.LoadFromStream(data, TRUE);
|
|
finally
|
|
fSelectDataset.Close;
|
|
data.Free;
|
|
end;
|
|
end;
|
|
|
|
function TRODBSessionManager.DoGetSessionCount: integer;
|
|
begin
|
|
CheckProperties;
|
|
fGetCountDataset.Open;
|
|
try
|
|
result := fGetCountDataset.Fields[0].AsInteger;
|
|
finally
|
|
fGetCountDataset.Close;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODBSessionManager.DoReleaseSession(aSession: TROSession; NewSession : boolean);
|
|
var params,lparams : TParams;
|
|
data : TStream;
|
|
provider : IProviderSupport;
|
|
begin
|
|
CheckProperties;
|
|
inherited;
|
|
data := TMemoryStream.Create;
|
|
try
|
|
if NewSession then begin
|
|
provider := GetProvider(fInsertDataset);
|
|
|
|
params := DoDatasetGetParams(fInsertDataset, provider);
|
|
lparams:=TParams.Create;
|
|
try
|
|
lparams.Assign(params);
|
|
lparams.ParamByName(fFieldNameSessionID).Value := DoConvertGUID(aSession.SessionID);
|
|
|
|
with lparams.ParamByName(fFieldNameLastAccessed) do
|
|
{$IFNDEF FPC}
|
|
if DataType = ftTimeStamp then
|
|
AsSQLTimeStamp := DateTimeToSQLTimeStamp(aSession.LastAccessed)
|
|
else
|
|
{$ENDIF}
|
|
AsDateTime := aSession.LastAccessed;
|
|
with lparams.ParamByName(fFieldNameCreated) do
|
|
{$IFNDEF FPC}
|
|
if DataType = ftTimeStamp then
|
|
AsSQLTimeStamp := DateTimeToSQLTimeStamp(aSession.Created)
|
|
else
|
|
{$ENDIF}
|
|
AsDateTime := aSession.Created;
|
|
aSession.SaveToStream(data, TRUE);
|
|
data.Position := 0;
|
|
lparams.ParamByName(fFieldNameData).LoadFromStream(data, ftBlob);
|
|
|
|
DoDatasetSetParams(fInsertDataset, provider, lparams);
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
DoDatasetExecute(fInsertDataset, provider);
|
|
end
|
|
else begin
|
|
provider := GetProvider(fUpdateDataset);
|
|
|
|
params := DoDatasetGetParams(fUpdateDataset, provider);
|
|
lparams:=TParams.Create;
|
|
try
|
|
lparams.Assign(params);
|
|
lparams.ParamByName(fFieldNameSessionID).Value := DoConvertGUID(aSession.SessionID);
|
|
with lparams.ParamByName(fFieldNameLastAccessed) do
|
|
{$IFNDEF FPC}
|
|
if DataType = ftTimeStamp then
|
|
AsSQLTimeStamp := DateTimeToSQLTimeStamp(aSession.LastAccessed)
|
|
else
|
|
{$ENDIF}
|
|
AsDateTime := aSession.LastAccessed;
|
|
aSession.SaveToStream(data, TRUE);
|
|
lparams.ParamByName(fFieldNameData).LoadFromStream(data, ftBlob);
|
|
DoDatasetsetParams(fUpdateDataset, provider, lparams);
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
DoDatasetExecute(fUpdateDataset, provider);
|
|
end;
|
|
provider := nil;
|
|
finally
|
|
data.Free;
|
|
end;
|
|
aSession.Free();
|
|
end;
|
|
|
|
procedure TRODBSessionManager.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
|
|
if (Operation=opRemove) then begin
|
|
if (AComponent=fInsertDataset) then fInsertDataset := NIL
|
|
else if (AComponent=fDeleteDataset) then fDeleteDataset := NIL
|
|
else if (AComponent=fUpdateDataset) then fUpdateDataset := NIL
|
|
else if (AComponent=fSelectDataset) then fSelectDataset := NIL
|
|
else if (AComponent=fGetCountDataset) then fGetCountDataset := NIL
|
|
else if (AComponent=fSelectAllDataset) then fSelectAllDataset := nil
|
|
else if (AComponent=fClearSessionsDataset) then begin
|
|
|
|
if (csDestroying in ComponentState) and ClearSessionsOnDestroy then begin
|
|
// Cleans up after itself. If you get an AV related to the dataset's connection
|
|
// be aware of the fact that the dataset's creation order MUST BE after its relative
|
|
// connection. To see your form's Creation Order simply right click on it and select
|
|
// the relative menu item.
|
|
|
|
DoClearSessions(false);
|
|
end;
|
|
|
|
fClearSessionsDataset := NIL
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODBSessionManager.SetClearSessionsDataset(const Value: TDataset);
|
|
begin
|
|
fClearSessionsDataset := Value;
|
|
if (Value<>NIL) then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBSessionManager.SetDeleteDataset(const Value: TDataset);
|
|
begin
|
|
fDeleteDataset := Value;
|
|
if (Value<>NIL) then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBSessionManager.SetGetCountDataset(const Value: TDataset);
|
|
begin
|
|
fGetCountDataset := Value;
|
|
if (Value<>NIL) then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBSessionManager.SetInsertDataset(const Value: TDataset);
|
|
begin
|
|
fInsertDataset := Value;
|
|
if (Value<>NIL) then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBSessionManager.SetSelectDataset(const Value: TDataset);
|
|
begin
|
|
fSelectDataset := Value;
|
|
if (Value<>NIL) then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBSessionManager.SetUpdateDataset(const Value: TDataset);
|
|
begin
|
|
fUpdateDataset := Value;
|
|
if (Value<>NIL) then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBSessionManager.Loaded;
|
|
begin
|
|
inherited;
|
|
|
|
if not (csDesigning in ComponentState) and ClearSessionsOnCreate
|
|
then DoClearSessions(false);
|
|
end;
|
|
|
|
procedure TRODBSessionManager.DoGetAllSessions(Dest: TStringList);
|
|
begin
|
|
CheckProperties;
|
|
fSelectAllDataset.Open;
|
|
try
|
|
fSelectAllDataset.First;
|
|
while not fSelectAllDataset.Eof do begin
|
|
Dest.Add(fSelectAllDataset.Fields[0].Value);
|
|
fSelectAllDataset.Next;
|
|
end;
|
|
finally
|
|
fSelectAllDataset.Close;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODBSessionManager.SetSelectAllDataset(const Value: TDataSet);
|
|
begin
|
|
fSelectAllDataset := Value;
|
|
if (Value<>NIL) then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
function TRODBSessionManager.DoConvertGUID(const aGUID: TGUID): string;
|
|
begin
|
|
if Assigned(fOnConvertGUID) then
|
|
try
|
|
Result:= fOnConvertGUID(Self, aGUID);
|
|
except
|
|
Result:= GUIDToString(aGUID);
|
|
end
|
|
else
|
|
Result:= GUIDToString(aGUID);
|
|
end;
|
|
|
|
procedure TRODBSessionManager.CheckProperties;
|
|
begin
|
|
Check(FieldNameSessionID = '', Name + '.FieldNameSessionID must be set.');
|
|
Check(FieldNameCreated = '', Name + '.FieldNameCreated must be set.');
|
|
Check(FieldNameLastAccessed = '', Name + '.FieldNameLastAccessed must be set.');
|
|
Check(FieldNameData = '', Name + '.FieldNameData must be set.');
|
|
Check(InsertDataset = nil, Name + '.InsertDataset must be assigned.');
|
|
Check(DeleteDataset = nil, Name + '.DeleteDataset must be assigned.');
|
|
Check(UpdateDataset = nil, Name + '.UpdateDataset must be assigned.');
|
|
Check(SelectDataset = nil, Name + '.SelectDataset must be assigned.');
|
|
Check(GetCountDataset = nil, Name + '.GetCountDataset must be assigned.');
|
|
Check(ClearSessionsDataset = nil, Name + '.ClearSessionsDataset must be assigned.');
|
|
Check(SelectAllDataset = nil, Name + '.SelectAllDataset must be assigned.');
|
|
end;
|
|
|
|
procedure TRODBSessionManager.DoDatasetExecute(aDataset: TDataset;
|
|
aProvider: IProviderSupport);
|
|
begin
|
|
if Assigned(fOnDatasetExecute) then
|
|
fOnDatasetExecute(Self,aDataset)
|
|
else if aProvider <> nil then
|
|
aProvider.PSExecute
|
|
else
|
|
raise Exception.CreateFmt('The %s.OnDatasetExecute event must be defined or %s should support IProviderSupport interface',[Self.Name, aDataset.Name]);
|
|
end;
|
|
|
|
function TRODBSessionManager.DoDatasetGetParams(aDataset: TDataset;
|
|
aProvider: IProviderSupport): TParams;
|
|
begin
|
|
if Assigned(fOnDatasetGetParams) then
|
|
Result := fOnDatasetGetParams(Self, aDataset)
|
|
else if aProvider <> nil then
|
|
Result := aProvider.PSGetParams
|
|
else
|
|
raise Exception.CreateFmt('The %s.OnDatasetGetParams event must be defined or %s should support IProviderSupport interface',[Self.Name, aDataset.Name]);
|
|
end;
|
|
|
|
procedure TRODBSessionManager.DoDatasetSetParams(aDataset: TDataset;
|
|
aProvider: IProviderSupport; AParams: TParams);
|
|
begin
|
|
if Assigned(fOnDatasetSetParams) then
|
|
fOnDatasetSetParams(Self, aDataset, AParams)
|
|
else if aProvider <> nil then
|
|
aProvider.PSSetParams(AParams)
|
|
else
|
|
raise Exception.CreateFmt('The %s.OnDatasetSetParams event must be defined or %s should support IProviderSupport interface',[Self.Name, aDataset.Name]);
|
|
end;
|
|
|
|
end.
|
|
|