david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
600 lines
24 KiB
ObjectPascal
600 lines
24 KiB
ObjectPascal
unit uRODBEventRepository;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ 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
|
|
SysUtils, Classes, DB, SyncObjs,
|
|
uROEventRepository, uROTypes;
|
|
|
|
type
|
|
{
|
|
------------------------------ sql script (MSSQL) ---------------------------------
|
|
CREATE TABLE [Messages](
|
|
[MessageInc] [int] IDENTITY(1,1) NOT NULL,
|
|
[Created] [datetime] NULL,
|
|
[SourceSessionID] [char](38) NOT NULL,
|
|
[Data] [image] NULL,
|
|
CONSTRAINT [PK_Messages] PRIMARY KEY
|
|
([MessageInc] ASC)
|
|
)
|
|
|
|
GO
|
|
|
|
CREATE INDEX [Messages_IDX1] ON [Messages] ([Created] ASC)
|
|
|
|
GO
|
|
|
|
CREATE TABLE [MessagesPerSession](
|
|
[SessionID] [char](38) NOT NULL,
|
|
[MessageInc] [int] NOT NULL,
|
|
CONSTRAINT [PK_MessagesPerSession] PRIMARY KEY
|
|
( [SessionID] ASC, [MessageInc] ASC)
|
|
)
|
|
|
|
GO
|
|
|
|
CREATE INDEX [MessagesPerSession_IDX1] ON [MessagesPerSession] ([MessageInc] ASC)
|
|
|
|
GO
|
|
|
|
--------------------------- SQLs --------------------------------------------------
|
|
|
|
InsertMessages: Insert into Messages (Created, SourceSessionID, Data) values (:Created, :SourceSessionID, :Data)
|
|
DeleteMessages: delete from Messages where MessageInc = :MessageInc
|
|
GetMessageInc: SELECT IsNull(Ident_Current('Messages'), 0) as LastInc
|
|
GetMessages: select m.MessageInc, m.Data from MessagesPerSession mps join Messages m on (m.MessageInc = mps.MessageInc) where mps.SessionID = :SessionID
|
|
DeleteUnusedMessages: delete from Messages where MessageInc not in (select distinct MessageInc from MessagesPerSession)
|
|
DeleteOldMessages: delete from Messages where Created < :Created
|
|
DeleteOldMessagesPerSession: delete from MessagesPerSession where MessageInc in (select MessageInc from Messages where Created < :Created)
|
|
|
|
InsertMessagesPerSession: Insert into MessagesPerSession (SessionID, MessageInc) values (:SessionID, :MessageInc)
|
|
DeleteMessagesPerSession: Delete from MessagesPerSession where SessionID = :SessionID and MessageInc = :MessageInc
|
|
}
|
|
|
|
|
|
{$IFDEF FPC}
|
|
IProviderSupport = interface
|
|
procedure PSExecute;
|
|
function PSGetParams: TParams;
|
|
procedure PSSetParams(AParams: TParams);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
TRODBEventRepository = class;
|
|
|
|
TRODBEventRepositoryConvertGUIDEvent = function(Sender: TRODBEventRepository; const aGUID: TGUID): string of object;
|
|
TRODBEventRepositoryDatasetGetParams = function(Sender: TRODBEventRepository; aDataset: TDataset): TParams of object;
|
|
TRODBEventRepositoryDatasetSetParams = procedure(Sender: TRODBEventRepository; aDataset: TDataset; aParams: TParams) of object;
|
|
TRODBEventRepositoryDatasetExecute = procedure(Sender: TRODBEventRepository; aDataset: TDataset) of object;
|
|
|
|
TRODBEventRepository = class(TROEventRepository)
|
|
private
|
|
FInsertMessagesDataset: TDataset;
|
|
FDeleteMessagesDataset: TDataset;
|
|
FGetMessagesDataset: TDataset;
|
|
fOnDatasetExecute: TRODBEventRepositoryDatasetExecute;
|
|
fOnDatasetGetParams: TRODBEventRepositoryDatasetGetParams;
|
|
fOnDatasetSetParams: TRODBEventRepositoryDatasetSetParams;
|
|
fOnConvertGUID: TRODBEventRepositoryConvertGUIDEvent;
|
|
fFieldName_Data: string;
|
|
fFieldName_Created: string;
|
|
fFieldName_SourceSessionID: string;
|
|
fFieldName_MessageInc: string;
|
|
fCriticalSection: TCriticalSection;
|
|
fFieldName_SessionID: string;
|
|
FGetMessageIncDataset: TDataset;
|
|
FInsertMessagesPerSessionDataset: TDataset;
|
|
FDeleteMessagesPerSessionDataset: TDataset;
|
|
FDeleteUnusedMessagesDataset: TDataset;
|
|
FDeleteOldMessagesDataset: TDataset;
|
|
FDeleteOldMessagesPerSessionDataset: TDataset;
|
|
procedure SetInsertMessagesDataset(const Value: TDataset);
|
|
procedure SetGetMessagesDataset(const Value: TDataset);
|
|
function DoDatasetGetParams(aDataset: TDataset; aProvider: IProviderSupport): TParams;
|
|
procedure DoDatasetSetParams(aDataset: TDataset; aProvider: IProviderSupport; AParams: TParams);
|
|
procedure DoDatasetExecute(aDataset: TDataset; aProvider: IProviderSupport);
|
|
function GetProvider(aDataset: TDataset): IProviderSupport;
|
|
procedure SetDeleteMessagesDataset(const Value: TDataset);
|
|
procedure SetGetMessageIncDataset(const Value: TDataset);
|
|
procedure SetInsertMessagesPerSessionDataset(const Value: TDataset);
|
|
procedure SetDeleteMessagesPerSessionDataset(const Value: TDataset);
|
|
procedure SetDeleteUnusedMessagesDataset(const Value: TDataset);
|
|
procedure SetDeleteOldMessagesDataset(const Value: TDataset);
|
|
procedure SetDeleteOldMessagesPerSessionDataset(const Value: TDataset);
|
|
protected
|
|
procedure Notification(aComponent: TComponent; Operation: TOperation); override;
|
|
procedure DoStoreEventData(SourceSessionID : TGUID; Data : Binary;
|
|
const ExcludeSender: Boolean;
|
|
const ExcludeSessionList: Boolean;
|
|
const SessionList: String); override;
|
|
function DoGetEventData(SessionID : TGUID; var TargetStream : Binary) : integer; override;
|
|
procedure DoAddSession(aSessionID : TGUID); override;
|
|
procedure DoRemoveSession(aSessionID : TGUID); override;
|
|
function DoConvertGUID(const aGUID: TGUID): string; virtual;
|
|
public
|
|
constructor Create(aOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure CheckProperties; override;
|
|
procedure DeleteUnusedMessages;
|
|
procedure DeleteOldMessages;
|
|
published
|
|
property FieldName_Created : string read fFieldName_Created write fFieldName_Created;
|
|
property FieldName_Data : string read fFieldName_Data write fFieldName_Data;
|
|
property FieldName_MessageInc : string read fFieldName_MessageInc write fFieldName_MessageInc;
|
|
property FieldName_SessionID : string read fFieldName_SessionID write fFieldName_SessionID;
|
|
property FieldName_SourceSessionID : string read fFieldName_SourceSessionID write fFieldName_SourceSessionID;
|
|
|
|
Property InsertMessagesDataset: TDataset read FInsertMessagesDataset write SetInsertMessagesDataset;
|
|
Property GetMessagesDataset: TDataset read FGetMessagesDataset write SetGetMessagesDataset;
|
|
Property DeleteMessagesDataset: TDataset read FDeleteMessagesDataset write SetDeleteMessagesDataset;
|
|
Property GetMessageIncDataset: TDataset read FGetMessageIncDataset write SetGetMessageIncDataset;
|
|
property InsertMessagesPerSessionDataset: TDataset read FInsertMessagesPerSessionDataset write SetInsertMessagesPerSessionDataset;
|
|
Property DeleteMessagesPerSessionDataset: TDataset read FDeleteMessagesPerSessionDataset write SetDeleteMessagesPerSessionDataset;
|
|
property DeleteUnusedMessagesDataset: TDataset read FDeleteUnusedMessagesDataset write SetDeleteUnusedMessagesDataset;
|
|
property DeleteOldMessagesDataset: TDataset read FDeleteOldMessagesDataset write SetDeleteOldMessagesDataset;
|
|
property DeleteOldMessagesPerSessionDataset: TDataset read FDeleteOldMessagesPerSessionDataset write SetDeleteOldMessagesPerSessionDataset;
|
|
|
|
property OnDatasetGetParams: TRODBEventRepositoryDatasetGetParams read fOnDatasetGetParams write fOnDatasetGetParams;
|
|
property OnDatasetSetParams: TRODBEventRepositoryDatasetSetParams read fOnDatasetSetParams write fOnDatasetSetParams;
|
|
property OnDatasetExecute : TRODBEventRepositoryDatasetExecute read fOnDatasetExecute write fOnDatasetExecute;
|
|
property OnConvertGUID: TRODBEventRepositoryConvertGUIDEvent read fOnConvertGUID write fOnConvertGUID;
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
uROClasses,{$IFNDEF FPC}SqlTimSt,{$ENDIF} uROSessions;
|
|
|
|
{ TRODBEventRepository }
|
|
|
|
procedure TRODBEventRepository.CheckProperties;
|
|
begin
|
|
inherited;
|
|
Check(FieldName_Created = '', Name + '.FieldName_Created must be set.');
|
|
Check(FieldName_Data = '', Name + '.FieldName_Data must be set.');
|
|
Check(FieldName_MessageInc = '', Name + '.FieldName_MessageInc must be set.');
|
|
Check(FieldName_SessionID = '', Name + '.FieldName_SessionID must be set.');
|
|
Check(FieldName_SourceSessionID = '', Name + '.FieldName_SourceSessionID must be set.');
|
|
Check(SessionManager = nil, Name + '.SessionManager must be assigned.');
|
|
SessionManager.CheckProperties;
|
|
Check(FInsertMessagesDataset = nil, Name + '.InsertMessagesDataset must be assigned.');
|
|
Check(FDeleteMessagesDataset = nil, Name + '.DeleteMessagesDataset must be assigned.');
|
|
Check(FGetMessagesDataset = nil, Name + '.GetMessagesDataset must be assigned.');
|
|
Check(FGetMessageIncDataset = nil, Name + '.GetMessageIncDataset must be assigned.');
|
|
Check(FInsertMessagesPerSessionDataset = nil, Name + '.InsertMessagesPerSessionDataset must be assigned.');
|
|
Check(FDeleteMessagesPerSessionDataset = nil, Name + '.DeleteMessagesPerSessionDataset must be assigned.');
|
|
Check(FDeleteUnusedMessagesDataset = nil, Name + '.DeleteUnusedMessagesDataset must be assigned.');
|
|
Check(FDeleteOldMessagesDataset = nil, Name + '.DeleteOldMessagesDataset must be assigned.');
|
|
Check(FDeleteOldMessagesPerSessionDataset = nil, Name + '.DeleteOldMessagesPerSessionDataset must be assigned.');
|
|
|
|
end;
|
|
|
|
constructor TRODBEventRepository.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fFieldName_MessageInc := 'MessageInc';
|
|
fFieldName_Created := 'Created';
|
|
fFieldName_SourceSessionID := 'SourceSessionID';
|
|
fFieldName_Data := 'Data';
|
|
fFieldName_SessionID := 'SessionID';
|
|
fCriticalSection := TCriticalSection.Create;
|
|
end;
|
|
|
|
destructor TRODBEventRepository.Destroy;
|
|
begin
|
|
fCriticalSection.Enter;
|
|
try
|
|
inherited;
|
|
finally
|
|
fCriticalSection.Leave;
|
|
fCriticalSection.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODBEventRepository.DoAddSession(aSessionID: TGUID);
|
|
begin
|
|
SessionManager.CreateSession(aSessionID);
|
|
end;
|
|
|
|
function TRODBEventRepository.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 TRODBEventRepository.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 TRODBEventRepository.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 TRODBEventRepository.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;
|
|
|
|
function TRODBEventRepository.DoGetEventData(SessionID: TGUID; var TargetStream: Binary): integer;
|
|
var
|
|
params,lParams : TParams;
|
|
provider : IProviderSupport;
|
|
lBlobSize : integer;
|
|
fld: TBlobField;
|
|
fld1: TField;
|
|
k: integer;
|
|
begin
|
|
fCriticalSection.Enter;
|
|
try
|
|
result := 0;
|
|
TargetStream := Binary.Create;
|
|
TargetStream.Write(result, SizeOf(result));
|
|
try
|
|
provider := GetProvider(FGetMessagesDataset);
|
|
params := DoDatasetGetParams(FGetMessagesDataset, provider);
|
|
lParams:=TParams.Create;
|
|
try
|
|
lParams.Assign(params);
|
|
lparams.ParamByName(fFieldName_SessionID).AsString := DoConvertGUID(SessionID);
|
|
DoDatasetSetParams(fGetMessagesDataset, provider, lParams);
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
provider:=nil;
|
|
|
|
|
|
provider := GetProvider(FDeleteMessagesPerSessionDataset);
|
|
params := DoDatasetGetParams(FDeleteMessagesPerSessionDataset, provider);
|
|
lParams:=TParams.Create;
|
|
try
|
|
lParams.Assign(params);
|
|
lparams.ParamByName(fFieldName_SessionID).AsString := DoConvertGUID(SessionID);
|
|
k := lparams.ParamByName(fFieldName_MessageInc).Index;
|
|
|
|
fGetMessagesDataset.Open;
|
|
try
|
|
if not (fGetMessagesDataset.bof and fGetMessagesDataset.Eof) then begin
|
|
fld := TBlobField(fGetMessagesDataset.FieldByName(fFieldName_Data));
|
|
fld1:= fGetMessagesDataset.FieldByName(fFieldName_MessageInc);
|
|
while not fGetMessagesDataset.Eof do begin
|
|
Inc(Result);
|
|
lBlobSize := fld.BlobSize;
|
|
TargetStream.Write(lblobsize, SizeOf(integer));
|
|
fld.SaveToStream(TargetStream);
|
|
|
|
// remove processed session
|
|
lParams[k].AsInteger := fld1.AsInteger;
|
|
DoDatasetSetParams(FDeleteMessagesPerSessionDataset, provider, lParams);
|
|
DoDatasetExecute(FDeleteMessagesPerSessionDataset, provider);
|
|
|
|
fGetMessagesDataset.Next;
|
|
end;
|
|
end;
|
|
finally
|
|
fGetMessagesDataset.Close;
|
|
end;
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
finally
|
|
TargetStream.Position := 0;
|
|
TargetStream.Write(result, SizeOf(result));
|
|
TargetStream.Position := 0;
|
|
end;
|
|
DeleteUnusedMessages;
|
|
finally
|
|
provider:=nil;
|
|
fCriticalSection.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODBEventRepository.DoRemoveSession(aSessionID: TGUID);
|
|
begin
|
|
SessionManager.DeleteSession(aSessionID,False);
|
|
end;
|
|
|
|
procedure TRODBEventRepository.DoStoreEventData(SourceSessionID: TGUID;
|
|
Data: Binary; const ExcludeSender, ExcludeSessionList: Boolean;
|
|
const SessionList: String);
|
|
var
|
|
params,lParams : TParams;
|
|
provider : IProviderSupport;
|
|
|
|
filteredsessionslist : TStringList;
|
|
lsessionList : TStringList;
|
|
isfiltered : boolean;
|
|
|
|
i,k: integer;
|
|
currsessionid,lSourceSessionID: string;
|
|
lNeedtoDelete: Boolean;
|
|
lMessageInc: integer;
|
|
begin
|
|
filteredsessionslist := nil;
|
|
fCriticalSection.Enter;
|
|
try
|
|
lSourceSessionID := DoConvertGUID(SourceSessionID);
|
|
lsessionList := TStringList.Create;
|
|
try
|
|
SessionManager.GetAllSessions(lsessionList);
|
|
|
|
filteredsessionslist := NIL;
|
|
isfiltered := SessionList<>'';
|
|
if isfiltered then begin
|
|
filteredsessionslist := TStringList.Create;
|
|
filteredsessionslist.Sorted := TRUE;
|
|
filteredsessionslist.Duplicates := dupIgnore;
|
|
filteredsessionslist.CommaText := SessionList;
|
|
end;
|
|
|
|
// Filters the sessions the message will go to
|
|
For i:= lsessionList.Count-1 downto 0 do begin
|
|
currsessionid := lsessionList[i];
|
|
lNeedtoDelete := False;
|
|
if isfiltered then begin
|
|
k := filteredsessionslist.IndexOf(currsessionid);
|
|
if ExcludeSessionList then begin
|
|
if k <> -1 then lNeedtoDelete := True
|
|
end
|
|
else begin
|
|
if k = -1 then lNeedtoDelete := True
|
|
end;
|
|
end;
|
|
if ExcludeSender and (currsessionid = lSourceSessionID) then lNeedtoDelete := True;
|
|
if lNeedtoDelete then lsessionList.Delete(i);
|
|
end;
|
|
|
|
// Checks if the sender is not the only session left. If so, the event doesn't need to be stored
|
|
if (lsessionList.Count = 0) or
|
|
((lsessionList.Count = 1) and (lsessionList[0] = lSourceSessionID)) then Exit;
|
|
|
|
provider := GetProvider(FInsertMessagesDataset);
|
|
params := DoDatasetGetParams(FInsertMessagesDataset, provider);
|
|
lParams:=TParams.Create;
|
|
try
|
|
lParams.Assign(Params);
|
|
//lparams.ParamByName(fFieldName_MessageInc).AsString := currsessionid;
|
|
with lparams.ParamByName(fFieldName_Created) do
|
|
{$IFNDEF FPC}
|
|
if DataType = ftTimeStamp then
|
|
AsSQLTimeStamp := DateTimeToSQLTimeStamp(Now)
|
|
else
|
|
{$ENDIF}
|
|
AsDateTime := Now;
|
|
lparams.ParamByName(fFieldName_SourceSessionID).AsString := lSourceSessionID;
|
|
lparams.ParamByName(fFieldName_Data).LoadFromStream(data, ftBlob);
|
|
DoDatasetSetParams(FInsertMessagesDataset, provider, lParams);
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
DoDatasetExecute(FInsertMessagesDataset, provider);
|
|
|
|
FGetMessageIncDataset.Open;
|
|
lMessageInc := FGetMessageIncDataset.Fields[0].AsInteger;
|
|
FGetMessageIncDataset.Close;
|
|
|
|
provider := GetProvider(FInsertMessagesPerSessionDataset);
|
|
params := DoDatasetGetParams(FInsertMessagesPerSessionDataset, provider);
|
|
lParams:=TParams.Create;
|
|
try
|
|
lParams.Assign(Params);
|
|
lparams.ParamByName(fFieldName_MessageInc).AsInteger := lMessageInc;
|
|
k := lparams.ParamByName(fFieldName_SessionID).Index;
|
|
|
|
For i:= 0 to lsessionList.Count-1 do begin
|
|
lparams[k].AsString := lsessionList[i];
|
|
DoDatasetSetParams(FInsertMessagesPerSessionDataset, provider, lParams);
|
|
DoDatasetExecute(FInsertMessagesPerSessionDataset,provider);
|
|
end;
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
finally
|
|
provider := nil;
|
|
lsessionList.Free;
|
|
filteredsessionslist.Free;
|
|
end;
|
|
finally
|
|
fCriticalSection.Leave;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TRODBEventRepository.GetProvider(
|
|
aDataset: TDataset): IProviderSupport;
|
|
begin
|
|
if aDataset = nil then
|
|
Result := nil
|
|
{$IFNDEF FPC}
|
|
{$IFDEF DELPHI7UP}
|
|
else
|
|
result := aDataset as IProviderSupport;
|
|
{$ELSE}
|
|
else
|
|
result := IProviderSupport(aDataset);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
procedure TRODBEventRepository.Notification(aComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if (Operation<>opRemove) then Exit;
|
|
|
|
if aComponent = FInsertMessagesDataset then FInsertMessagesDataset := nil
|
|
else if aComponent = FGetMessagesDataset then FGetMessagesDataset := nil
|
|
else if aComponent = FDeleteMessagesDataset then FDeleteMessagesDataset := nil
|
|
else if aComponent = FGetMessageIncDataset then FGetMessageIncDataset := nil
|
|
else if aComponent = FInsertMessagesPerSessionDataset then FInsertMessagesPerSessionDataset := nil
|
|
else if aComponent = FDeleteMessagesPerSessionDataset then FDeleteMessagesPerSessionDataset := nil
|
|
else if aComponent = FDeleteUnusedMessagesDataset then FDeleteMessagesPerSessionDataset := nil
|
|
else if aComponent = FDeleteOldMessagesPerSessionDataset then FDeleteOldMessagesPerSessionDataset := nil
|
|
;
|
|
end;
|
|
|
|
procedure TRODBEventRepository.SetDeleteMessagesDataset(const Value: TDataset);
|
|
begin
|
|
if Assigned(FDeleteMessagesDataset) then FDeleteMessagesDataset.RemoveFreeNotification(Self);
|
|
FDeleteMessagesDataset := Value;
|
|
if Assigned(FDeleteMessagesDataset) then FDeleteMessagesDataset.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBEventRepository.SetGetMessageIncDataset(
|
|
const Value: TDataset);
|
|
begin
|
|
if Assigned(FGetMessageIncDataset) then FGetMessageIncDataset.RemoveFreeNotification(Self);
|
|
FGetMessageIncDataset := Value;
|
|
if Assigned(FGetMessageIncDataset) then FGetMessageIncDataset.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBEventRepository.SetInsertMessagesDataset(const Value: TDataset);
|
|
begin
|
|
if Assigned(FInsertMessagesDataset) then FInsertMessagesDataset.RemoveFreeNotification(Self);
|
|
FInsertMessagesDataset := Value;
|
|
if Assigned(FInsertMessagesDataset) then FInsertMessagesDataset.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBEventRepository.SetInsertMessagesPerSessionDataset(
|
|
const Value: TDataset);
|
|
begin
|
|
if Assigned(FInsertMessagesPerSessionDataset) then FInsertMessagesPerSessionDataset.RemoveFreeNotification(Self);
|
|
FInsertMessagesPerSessionDataset := Value;
|
|
if Assigned(FInsertMessagesPerSessionDataset) then FInsertMessagesPerSessionDataset.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBEventRepository.SetGetMessagesDataset(const Value: TDataset);
|
|
begin
|
|
if Assigned(FGetMessagesDataset) then FGetMessagesDataset.RemoveFreeNotification(Self);
|
|
FGetMessagesDataset := Value;
|
|
if Assigned(FGetMessagesDataset) then FGetMessagesDataset.FreeNotification(Self);
|
|
end;
|
|
|
|
|
|
procedure TRODBEventRepository.SetDeleteMessagesPerSessionDataset(
|
|
const Value: TDataset);
|
|
begin
|
|
if Assigned(FDeleteMessagesPerSessionDataset) then FDeleteMessagesPerSessionDataset.RemoveFreeNotification(Self);
|
|
FDeleteMessagesPerSessionDataset := Value;
|
|
if Assigned(FDeleteMessagesPerSessionDataset) then FDeleteMessagesPerSessionDataset.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBEventRepository.SetDeleteUnusedMessagesDataset(
|
|
const Value: TDataset);
|
|
begin
|
|
if Assigned(FDeleteUnusedMessagesDataset) then FDeleteUnusedMessagesDataset.RemoveFreeNotification(Self);
|
|
FDeleteUnusedMessagesDataset := Value;
|
|
if Assigned(FDeleteUnusedMessagesDataset) then FDeleteUnusedMessagesDataset.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBEventRepository.DeleteUnusedMessages;
|
|
var
|
|
provider: IProviderSupport;
|
|
begin
|
|
fCriticalSection.Enter;
|
|
try
|
|
provider := GetProvider(FDeleteUnusedMessagesDataset);
|
|
DoDatasetExecute(FDeleteUnusedMessagesDataset, provider);
|
|
finally
|
|
provider:=nil;
|
|
fCriticalSection.Leave;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TRODBEventRepository.SetDeleteOldMessagesDataset(
|
|
const Value: TDataset);
|
|
begin
|
|
if Assigned(FDeleteOldMessagesDataset) then FDeleteOldMessagesDataset.RemoveFreeNotification(Self);
|
|
FDeleteOldMessagesDataset := Value;
|
|
if Assigned(FDeleteOldMessagesDataset) then FDeleteOldMessagesDataset.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRODBEventRepository.DeleteOldMessages;
|
|
|
|
Procedure FillandExecute(aDataset: TDataset; ACreated: TDatetime);
|
|
var
|
|
provider: IProviderSupport;
|
|
params,lParams: TParams;
|
|
begin
|
|
provider := GetProvider(ADataset);
|
|
params := DoDatasetGetParams(ADataset, provider);
|
|
lParams:=TParams.Create;
|
|
try
|
|
lParams.Assign(params);
|
|
with lparams.ParamByName(fFieldName_Created) do
|
|
{$IFNDEF FPC}
|
|
if DataType = ftTimeStamp then
|
|
AsSQLTimeStamp := DateTimeToSQLTimeStamp(ACreated)
|
|
else
|
|
{$ENDIF}
|
|
AsDateTime := ACreated;
|
|
DoDatasetSetParams(ADataset, provider, lParams);
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
DoDatasetExecute(ADataset, provider);
|
|
provider:=nil;
|
|
end;
|
|
|
|
var
|
|
lCreated: TDatetime;
|
|
begin
|
|
lCreated := Now-30; // 30 days
|
|
fCriticalSection.Enter;
|
|
try
|
|
FillandExecute(FDeleteOldMessagesPerSessionDataset,lCreated);
|
|
FillandExecute(FDeleteOldMessagesDataset,lCreated);
|
|
finally
|
|
fCriticalSection.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODBEventRepository.SetDeleteOldMessagesPerSessionDataset(
|
|
const Value: TDataset);
|
|
begin
|
|
if Assigned(FDeleteOldMessagesPerSessionDataset) then FDeleteOldMessagesPerSessionDataset.RemoveFreeNotification(Self);
|
|
FDeleteOldMessagesPerSessionDataset := Value;
|
|
if Assigned(FDeleteOldMessagesPerSessionDataset) then FDeleteOldMessagesPerSessionDataset.FreeNotification(Self);
|
|
end;
|
|
|
|
end.
|