david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
395 lines
13 KiB
ObjectPascal
395 lines
13 KiB
ObjectPascal
unit uDADBSessionManager;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up, Kylix 3 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the Data Abstract }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I DataAbstract.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{vcl:}SysUtils, Classes,
|
|
{RemObjects: SDK}uROSessions,
|
|
{Data Abstract:}uDAInterfaces, uDAClasses;
|
|
|
|
type
|
|
TDAConvertGUIDEvent = function(Sender: TROCustomSessionManager; const aGUID: TGUID): string of object;
|
|
TDADBSessionManager = class(TROCustomSessionManager)
|
|
private
|
|
fSchema: TDASchema;
|
|
fDeleteSession: string;
|
|
fUpdateSession: string;
|
|
fInsertSession: string;
|
|
fGetSession: string;
|
|
fClearSessions: string;
|
|
fGetSessionCount: string;
|
|
fConnection: string;
|
|
fFieldNameSessionID: string;
|
|
fFieldNameCreated: string;
|
|
fFieldNameLastAccessed: string;
|
|
fFieldNameData: string;
|
|
fClearSessionsOnCreate: boolean;
|
|
fClearSessionsOnDestroy: boolean;
|
|
fGetAllSessionIDs: string;
|
|
fOnConvertGUID: TDAConvertGUIDEvent;
|
|
FForceTransaction: Boolean;
|
|
FNeedTransactionAction: Boolean;
|
|
procedure SetSchema(const Value: TDASchema);
|
|
{ Private declarations }
|
|
procedure BeginTransaction(AConnection: IDAConnection);
|
|
procedure CommitTransaction(AConnection: IDAConnection);
|
|
procedure RollbackTransaction(AConnection: IDAConnection);
|
|
function GetConnection: IDAConnection;
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
|
|
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;
|
|
public
|
|
{ Public declarations }
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure CheckProperties; override;
|
|
published
|
|
property Schema: TDASchema read fSchema write SetSchema;
|
|
|
|
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 InsertSessionCommand: string read fInsertSession write fInsertSession;
|
|
property UpdateSessionCommand: string read fUpdateSession write fUpdateSession;
|
|
property DeleteSessionCommand: string read fDeleteSession write fDeleteSession;
|
|
property ClearSessionsCommand: string read fClearSessions write fClearSessions;
|
|
property GetSessionCountDataSet: string read fGetSessionCount write fGetSessionCount;
|
|
property GetSessionDataSet: string read fGetSession write fGetSession;
|
|
property GetAllSessionIDsDataset: string read fGetAllSessionIDs write fGetAllSessionIDs;
|
|
|
|
property ClearSessionsOnCreate: boolean read fClearSessionsOnCreate write fClearSessionsOnCreate default true;
|
|
property ClearSessionsOnDestroy: boolean read fClearSessionsOnDestroy write fClearSessionsOnDestroy default true;
|
|
|
|
property Connection: string read fConnection write fConnection;
|
|
property OnConvertGUID: TDAConvertGUIDEvent read fOnConvertGUID write fOnConvertGUID;
|
|
property AutoTransaction: Boolean read FForceTransaction write FForceTransaction default false;
|
|
property SessionDuration;
|
|
property SessionCheckInterval;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
uROClasses, uROTypes;
|
|
|
|
constructor TDADBSessionManager.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
fClearSessionsOnDestroy := TRUE;
|
|
ClearSessionsOnCreate := TRUE;
|
|
|
|
fFieldNameSessionID := 'SessionID';
|
|
fFieldNameCreated := 'Created';
|
|
fFieldNameLastAccessed := 'LastAccessed';
|
|
fFieldNameData := 'Data';
|
|
end;
|
|
|
|
destructor TDADBSessionManager.Destroy;
|
|
begin
|
|
Schema := nil;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDADBSessionManager.DoClearSessions(OnlyExpired: boolean);
|
|
var
|
|
lCommand: IDASQLCommand;
|
|
lDataSet: IDADataset;
|
|
lConnection: IDAConnection;
|
|
lDate: TDateTime;
|
|
lFieldNameSessionID: integer;
|
|
lLastAccessIndex: integer;
|
|
begin
|
|
if OnlyExpired then
|
|
lDate := ((Now * MinsPerDay) - SessionDuration) / MinsPerDay
|
|
else
|
|
lDate := Now + 30; // 30 days from now. Enough to say all! <G>
|
|
if Assigned(OnBeforeDeleteSession) then begin
|
|
lConnection := GetConnection;
|
|
lDataSet := Schema.NewDataset(lConnection, GetAllSessionIDsDataset);
|
|
BeginTransaction(lConnection);
|
|
try
|
|
lDataSet.Open;
|
|
except
|
|
RollbackTransaction(lConnection);
|
|
raise;
|
|
end;
|
|
CommitTransaction(lConnection);
|
|
lFieldNameSessionID:= lDataSet.FieldByName(FieldNameSessionID).Index;
|
|
lLastAccessIndex:= lDataSet.FieldByName(FieldNameLastAccessed).Index;
|
|
try
|
|
while not lDataSet.EOF do
|
|
try
|
|
if lDataSet.Fields[lLastAccessIndex].AsDateTime <= lDate then
|
|
DeleteSession(lDataSet.Fields[lFieldNameSessionID].AsGuid,OnlyExpired);
|
|
finally
|
|
lDataSet.Next;
|
|
end;
|
|
finally
|
|
lDataSet.Close();
|
|
end;
|
|
end
|
|
else begin
|
|
lConnection:=GetConnection;
|
|
lCommand := Schema.NewCommand(lConnection, ClearSessionsCommand);
|
|
lCommand.ParamByName(FieldNameLastAccessed).Value := lDate;
|
|
BeginTransaction(lConnection);
|
|
try
|
|
lCommand.Execute();
|
|
except
|
|
RollbackTransaction(lConnection);
|
|
Raise;
|
|
end;
|
|
CommitTransaction(lConnection);
|
|
end;
|
|
end;
|
|
|
|
procedure TDADBSessionManager.DoDeleteSession(const aSessionID: TGUID; IsExpired: boolean);
|
|
var
|
|
lCommand: IDASQLCommand;
|
|
lConnection: IDAConnection;
|
|
begin
|
|
{$IFDEF FPC}
|
|
if IsExpired then lConnection := GetConnection else // remove warning
|
|
{$ENDIF}
|
|
lConnection := GetConnection;
|
|
lCommand := Schema.NewCommand(lConnection, DeleteSessionCommand);
|
|
lCommand.ParamByName(FieldNameSessionID).Value := DoConvertGUID(aSessionID);
|
|
BeginTransaction(lConnection);
|
|
try
|
|
lCommand.Execute();
|
|
except
|
|
RollbackTransaction(lConnection);
|
|
raise;
|
|
end;
|
|
CommitTransaction(lConnection);
|
|
end;
|
|
|
|
function TDADBSessionManager.DoFindSession(const aSessionID: TGUID; aUpdateTime: Boolean): TROSession;
|
|
var
|
|
lDataSet: IDADataSet;
|
|
lData: Binary;
|
|
lDataField: TDAField;
|
|
lConnection: IDAConnection;
|
|
begin
|
|
{$IFDEF FPC}
|
|
if aUpdateTime then result := nil else //remove warning
|
|
{$ENDIF}
|
|
result := nil;
|
|
|
|
lConnection := GetConnection;
|
|
lDataSet := Schema.NewDataset(lConnection, GetSessionDataSet);
|
|
lDataSet.ParamByName(FieldNameSessionID).AsString := DoConvertGUID(aSessionID);
|
|
|
|
BeginTransaction(lConnection);
|
|
try
|
|
lDataSet.Open;
|
|
except
|
|
RollbackTransaction(lConnection);
|
|
raise;
|
|
end;
|
|
CommitTransaction(lConnection);
|
|
|
|
try
|
|
if lDataSet.EOF then Exit;
|
|
|
|
result := DoCreateSession(aSessionID);
|
|
result.Created := lDataSet.FieldByName(FieldNameCreated).AsDateTime;
|
|
result.LastAccessed := lDataSet.FieldByName(FieldNameLastAccessed).AsDateTime;
|
|
|
|
lData := Binary.Create;
|
|
try
|
|
lDataField := lDataSet.FieldByName(fFieldNameData);
|
|
lDataField.SaveToStream(NewROStream(lData, false));
|
|
//lData := BinaryFromVariant(lDataSet.FieldByName(FieldNameData).Value);
|
|
//try
|
|
lData.Seek(0, soFromBeginning);
|
|
result.LoadFromStream(lData, true);
|
|
finally
|
|
lData.Free;
|
|
end;
|
|
finally
|
|
lDataSet.Close();
|
|
end;
|
|
end;
|
|
|
|
procedure TDADBSessionManager.DoGetAllSessions(Dest: TStringList);
|
|
var
|
|
lDataSet: IDADataSet;
|
|
lConnection: IDAConnection;
|
|
begin
|
|
lConnection := GetConnection;
|
|
|
|
lDataSet := Schema.NewDataset(lConnection, GetAllSessionIDsDataset);
|
|
BeginTransaction(lConnection);
|
|
try
|
|
lDataSet.Open;
|
|
except
|
|
RollbackTransaction(lConnection);
|
|
raise;
|
|
end;
|
|
CommitTransaction(lConnection);
|
|
|
|
try
|
|
while not lDataSet.EOF do try
|
|
Dest.Add(lDataSet.Fields[0].AsString);
|
|
finally
|
|
lDataSet.Next;
|
|
end;
|
|
finally
|
|
lDataSet.Close();
|
|
end;
|
|
end;
|
|
|
|
function TDADBSessionManager.DoGetSessionCount: integer;
|
|
var
|
|
lDataSet: IDADataSet;
|
|
lConnection: IDAConnection;
|
|
begin
|
|
lConnection := GetConnection;
|
|
lDataSet := Schema.NewDataset(lConnection, GetSessionCountDataSet);
|
|
BeginTransaction(lConnection);
|
|
try
|
|
lDataSet.Open;
|
|
except
|
|
RollbackTransaction(lConnection);
|
|
raise;
|
|
end;
|
|
CommitTransaction(lConnection);
|
|
try
|
|
result := lDataSet.Fields[0].AsInteger;
|
|
finally
|
|
lDataSet.Close();
|
|
end;
|
|
end;
|
|
|
|
procedure TDADBSessionManager.DoReleaseSession(aSession: TROSession; NewSession: boolean);
|
|
var
|
|
lCommand: IDASQLCommand;
|
|
lData: Binary;
|
|
lConnection: IDAConnection;
|
|
begin
|
|
inherited;
|
|
lConnection := GetConnection;
|
|
if NewSession then begin
|
|
lCommand := Schema.NewCommand(lConnection, InsertSessionCommand);
|
|
lCommand.ParamByName(FieldNameCreated).AsDateTime := aSession.Created;
|
|
end
|
|
else begin
|
|
lCommand := Schema.NewCommand(lConnection, UpdateSessionCommand);
|
|
end;
|
|
lCommand.ParamByName(FieldNameSessionID).AsString := DoConvertGUID(aSession.SessionID);
|
|
lCommand.ParamByName(FieldNameLastAccessed).AsDateTime := aSession.LastAccessed;
|
|
lData := Binary.Create;
|
|
try
|
|
aSession.SaveToStream(lData, TRUE);
|
|
lData.Seek(0, soFromBeginning);
|
|
lCommand.ParamByName(FieldNameData).LoadFromStream(NewROStream(lData, false));
|
|
finally
|
|
lData.Free;
|
|
end;
|
|
BeginTransaction(lConnection);
|
|
try
|
|
lCommand.Execute();
|
|
except
|
|
RollbackTransaction(lConnection);
|
|
raise;
|
|
end;
|
|
CommitTransaction(lConnection);
|
|
if ((NewSession) and (Assigned(OnSessionCreated))) then OnSessionCreated(aSession);
|
|
aSession.Free();
|
|
end;
|
|
|
|
procedure TDADBSessionManager.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if Operation <> opRemove then exit;
|
|
if AComponent = Schema then Schema := nil;
|
|
end;
|
|
|
|
procedure TDADBSessionManager.SetSchema(const Value: TDASchema);
|
|
begin
|
|
if fSchema <> Value then begin
|
|
fSchema := Value;
|
|
if Assigned(Schema) then Schema.FreeNotification(self);
|
|
end;
|
|
end;
|
|
|
|
function TDADBSessionManager.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 TDADBSessionManager.BeginTransaction(AConnection: IDAConnection);
|
|
begin
|
|
with AConnection do begin
|
|
FNeedTransactionAction := FForceTransaction and not InTransaction;
|
|
if FNeedTransactionAction then BeginTransaction;
|
|
end;
|
|
end;
|
|
|
|
procedure TDADBSessionManager.CommitTransaction(AConnection: IDAConnection);
|
|
begin
|
|
if FNeedTransactionAction then AConnection.CommitTransaction;
|
|
end;
|
|
|
|
procedure TDADBSessionManager.RollbackTransaction(AConnection: IDAConnection);
|
|
begin
|
|
if FNeedTransactionAction then AConnection.RollbackTransaction;
|
|
end;
|
|
|
|
function TDADBSessionManager.GetConnection: IDAConnection;
|
|
begin
|
|
CheckProperties;
|
|
Result := Schema.ConnectionManager.NewConnection(Connection);
|
|
end;
|
|
|
|
procedure TDADBSessionManager.CheckProperties;
|
|
begin
|
|
Check(Schema = nil, Name+'.Schema must be assigned.');
|
|
Schema.CheckProperties;
|
|
Check(FieldNameSessionID = '', Name + '.FieldNameSessionID must be set.');
|
|
Check(FieldNameCreated = '', Name + '.FieldNameCreated must be set.');
|
|
Check(FieldNameLastAccessed = '', Name + '.FieldNameLastAccessed must be assigned.');
|
|
Check(FieldNameData = '', Name + '.FieldNameData must be set.');
|
|
Check(InsertSessionCommand = '', Name + '.InsertSessionCommand must be set.');
|
|
Check(DeleteSessionCommand = '', Name + '.DeleteSessionCommand must be set.');
|
|
Check(UpdateSessionCommand = '', Name + '.UpdateSessionCommand must be set.');
|
|
Check(ClearSessionsCommand = '', Name + '.ClearSessionsCommand must be set.');
|
|
Check(GetSessionCountDataSet = '', Name + '.GetSessionCountDataSet must be set.');
|
|
Check(GetSessionDataSet = '', Name + '.GetSessionDataSet must be set.');
|
|
Check(GetAllSessionIDsDataset = '', Name + '.GetAllSessionIDsDataset must be set.');
|
|
end;
|
|
|
|
end.
|