Componentes.Terceros.RemObj.../internal/5.0.24.615/1/Data Abstract for Delphi/Source/uDAServerLog.pas

616 lines
18 KiB
ObjectPascal

unit uDAServerLog;
{----------------------------------------------------------------------------}
{ 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
Classes, Contnrs, SysUtils, uROSessions, SyncObjs, uROTypes, uDAInterfaces,
uROXMLIntf, uROXMLSerializer;
const
EmptyGUID: TGUID = '{00000000-0000-0000-0000-000000000000}';
type
TDAServerLog = class;
{ TDALogItem }
TDALogItem = class(TROComplexType)
private
fServerLog: TDAServerLog;
fCreationTime: TDateTime;
fSessionID: TGUID;
function GetSessionIDAsString: string;
protected
procedure AssignSession(aSession: TROSession); virtual;
public
constructor Create(aServerLog: TDAServerLog; aSession: TROSession); reintroduce;
destructor Destroy; override;
property ServerLog: TDAServerLog read fServerLog;
{$IFDEF FPC}
property SessionID: TGUID read fSessionID;
{$ENDIF}
published
{$IFNDEF FPC}
property SessionID: TGUID read fSessionID;
{$ENDIF}
property SessionIDAsString: string read GetSessionIDAsString;
property CreationTime: TDateTime read fCreationTime;
end;
{ TDASessionLog }
TDASessionLog = class(TDALogItem)
private
fLoginInfo: TROComplexType;
protected
procedure AssignLoginInfo(aLoginInfo: TROComplexType); virtual;
public
constructor Create(aServerLog: TDAServerLog; aSession: TROSession; aLoginInfo: TROComplexType);
destructor Destroy; override;
published
property LoginInfo: TROComplexType read fLoginInfo;
end;
TDASessionLogClass = class of TDASessionLog;
{ TDASQLCommandLog }
TDASQLCommandLog = class(TDALogItem)
private
fActualSQLText: string;
fElapsedMilliseconds: Cardinal;
fOriginalSQLText: string;
fParams: TDAParamCollection;
protected
public
constructor Create(aServerLog: TDAServerLog; aSession: TROSession;
const aCommand: IDASQLCommand;
aActualSQLText: string; aElapsedMilliseconds: Cardinal);
destructor Destroy; override;
property Params: TDAParamCollection read fParams;
published
property OriginalSQLText: string read fOriginalSQLText;
property ActualSQLText: string read fActualSQLText;
property ElapsedMilliseconds: cardinal read fElapsedMilliseconds;
end;
TDASQLCommandLogClass = class of TDASQLCommandLog;
{ TDASQLErrorLog }
TDASQLErrorLog = class(TDASQLCommandLog)
private
fErrorMessage: string;
protected
public
constructor Create(aServerLog: TDAServerLog; aSession: TROSession;
aError: Exception; const aCommand: IDASQLCommand;
aActualSQLText: string);
property ErrorMessage: string read fErrorMessage;
end;
TDASQLErrorLogClass = class of TDASQLErrorLog;
{ Events }
TDASessionLogEvent = procedure(Sender: TDAServerLog; SessionLog: TDASessionLog) of object;
TDASessionLogRemoveEvent = procedure(Sender: TDAServerLog; SessionLog: TDASessionLog; var RemoveRelatedLogs: boolean) of object;
TDASQLCommandLogEvent = procedure(Sender: TDAServerLog; SQLCommandLog: TDASQLCommandLog) of object;
TDASQLErrorLogEvent = procedure(Sender: TDAServerLog; SQLErrorLog: TDASQLErrorLog) of object;
TDALogClassesDefinitionEvent = procedure(Sender: TDAServerLog;
var aSessionLogClass: TDASessionLogClass;
var aSQLCommandLogClass: TDASQLCommandLogClass;
var aSQLErrorLogClass: TDASQLErrorLogClass) of object;
{ TDAServerLog }
TDAServerLog = class(TComponent)
private
fSessionsLogs: TStringList;
fSQLCommandLogs,
fSQLErrorsLogs: TObjectList;
fOnAddSQLCommandLog: TDASQLCommandLogEvent;
fOnAddSQLErrorLog: TDASQLErrorLogEvent;
fOnAddSessionLog: TDASessionLogEvent;
fActive: boolean;
fOnRemoveSessionLog: TDASessionLogRemoveEvent;
fCriticalSessions,
fCriticalSQLCommands,
fCriticalSQLErrors: TCriticalSection;
fOnLogClassesDefinition: TDALogClassesDefinitionEvent;
fSessionLogClass: TDASessionLogClass;
fSQLCommandLogClass: TDASQLCommandLogClass;
fSQLErrorLogClass: TDASQLErrorLogClass;
function GetSQLCommandLogsCount: integer;
function GetSQLCommandLogs(Index: integer): TDASQLCommandLog;
function GetSQLErrorLogs(Index: integer): TDASQLErrorLog;
function GetSessionLogsCount: integer;
function GetSessionLogs(Index: integer): TDASessionLog;
function GetSQLErrorLogsCount: integer;
protected
procedure RegisterLogServer;
procedure UnRegisterLogServer;
procedure Loaded; override;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure SaveToXML(aFileName: string); overload;
procedure SaveToXML(const aXMLDocument: IXMLDocument); overload; virtual;
{ Session logs }
function FindSessionLog(aSession: TROSession): TDASessionLog; overload;
function FindSessionLog(aSessionID: TGUID): TDASessionLog; overload;
function AddSessionLog(aSession: TROSession; aLoginInfo: TROComplexType): TDASessionLog;
procedure RemoveSessionLog(aSessionID: TGUID; aRemoveRelatedLogs: boolean); overload;
procedure RemoveSessionLog(aSession: TROSession; aRemoveRelatedLogs: boolean); overload;
procedure ClearSessionLogs(aRemoveRelatedLogs: boolean);
{ SQL command logs }
function AddSQLCommandLog(aSession: TROSession; const aCommand: IDASQLCommand;
anActualSQLText: string; aElapsedMilliseconds: Cardinal): TDASQLCommandLog;
procedure ClearSQLCommandLogs; overload;
procedure ClearSQLCommandLogs(aSessionID: TGUID); overload;
{ SQL error logs }
function AddSQLErrorLog(aSession: TROSession; aError: Exception; const aCommand: IDASQLCommand;
aActualSQLText: string): TDASQLErrorLog;
procedure ClearSQLErrorLogs; overload;
procedure ClearSQLErrorLogs(aSessionID: TGUID); overload;
{ Properties }
property SessionLogs[Index: integer]: TDASessionLog read GetSessionLogs;
property SessionLogsCount: integer read GetSessionLogsCount;
property SQLCommandLogs[Index: integer]: TDASQLCommandLog read GetSQLCommandLogs;
property SQLCommandLogsCount: integer read GetSQLCommandLogsCount;
property SQLErrorLogs[Index: integer]: TDASQLErrorLog read GetSQLErrorLogs;
property SQLErrorLogsCount: integer read GetSQLErrorLogsCount;
published
property Active: boolean read fActive write fActive;
property OnAddSessionLog: TDASessionLogEvent read fOnAddSessionLog write fOnAddSessionLog;
property OnRemoveSessionLog: TDASessionLogRemoveEvent read fOnRemoveSessionLog write fOnRemoveSessionLog;
property OnAddSQLCommandLog: TDASQLCommandLogEvent read fOnAddSQLCommandLog write fOnAddSQLCommandLog;
property OnAddSQLErrorLog: TDASQLErrorLogEvent read fOnAddSQLErrorLog write fOnAddSQLErrorLog;
property OnLogClassesDefinition: TDALogClassesDefinitionEvent read fOnLogClassesDefinition write fOnLogClassesDefinition;
end;
function ServerLog: TDAServerLog;
implementation
var _ServerLog: TDAServerLog;
function ServerLog: TDAServerLog;
begin
if not Assigned(_ServerLog)
then raise Exception.Create('No TDAServerLog have been registered');
result := _ServerLog;
end;
{ TDALogItem }
procedure TDALogItem.AssignSession(aSession: TROSession);
begin
if Assigned(aSession)
then fSessionID := aSession.SessionID
else fSessionID := EmptyGUID;
end;
constructor TDALogItem.Create(aServerLog: TDAServerLog; aSession: TROSession);
begin
fCreationTime := Now;
fServerLog := aServerLog;
AssignSession(aSession);
end;
destructor TDALogItem.Destroy;
begin
inherited;
end;
function TDALogItem.GetSessionIDAsString: string;
begin
result := GUIDToString(fSessionID)
end;
{ TDASessionLog }
procedure TDASessionLog.AssignLoginInfo(aLoginInfo: TROComplexType);
begin
fLoginInfo := TROComplexTypeClass(aLoginInfo.ClassType).Create;
fLoginInfo.Assign(aLoginInfo);
end;
constructor TDASessionLog.Create(aServerLog: TDAServerLog; aSession: TROSession; aLoginInfo: TROComplexType);
begin
inherited Create(aServerLog, aSession);
AssignLoginInfo(aLoginInfo);
end;
destructor TDASessionLog.Destroy;
begin
FreeAndNIL(fLoginInfo);
inherited;
end;
{ TDASQLCommandLog }
constructor TDASQLCommandLog.Create(aServerLog: TDAServerLog; aSession: TROSession;
const aCommand: IDASQLCommand; aActualSQLText: string; aElapsedMilliseconds: Cardinal);
begin
inherited Create(aServerLog, aSession);
fElapsedMilliseconds := aElapsedMilliseconds;
fOriginalSQLText := aCommand.SQL;
fActualSQLText := aActualSQLText;
fParams := TDAParamCollection.Create(NIL);
if (aCommand.Params.Count>0)
then fParams.Assign(aCommand.Params);
end;
destructor TDASQLCommandLog.Destroy;
begin
FreeAndNIL(fParams);
inherited;
end;
{ TDASQLErrorLog }
constructor TDASQLErrorLog.Create(aServerLog: TDAServerLog; aSession: TROSession;
aError: Exception; const aCommand: IDASQLCommand; aActualSQLText: string);
begin
inherited Create(aServerLog, aSession, aCommand, aActualSQLText, 0);
fErrorMessage := aError.Message;
end;
{ TDAServerLog }
constructor TDAServerLog.Create(aOwner: TComponent);
begin
inherited;
fCriticalSessions := TCriticalSection.Create;
fCriticalSQLCommands := TCriticalSection.Create;
fCriticalSQLErrors := TCriticalSection.Create;
fSessionsLogs := TStringList.Create;
fSessionsLogs.Sorted := TRUE;
fSQLCommandLogs := TObjectList.Create;
fSQLErrorsLogs := TObjectList.Create;
end;
destructor TDAServerLog.Destroy;
begin
if not (csDesigning in ComponentState) then UnRegisterLogServer;
ClearSessionLogs(FALSE);
FreeAndNIL(fSessionsLogs);
ClearSQLCommandLogs;
FreeAndNIL(fSQLCommandLogs);
ClearSQLErrorLogs;
FreeAndNIL(fSQLErrorsLogs);
FreeAndNIL(fCriticalSessions);
FreeAndNIL(fCriticalSQLCommands);
FreeAndNIL(fCriticalSQLErrors);
inherited;
end;
procedure TDAServerLog.Loaded;
begin
if (csDesigning in ComponentState) then Exit;
RegisterLogServer;
fSessionLogClass := TDASessionLog;
fSQLCommandLogClass := TDASQLCommandLog;
fSQLErrorLogClass := TDASQLErrorLog;
if Assigned(fOnLogClassesDefinition)
then fOnLogClassesDefinition(Self, fSessionLogClass, fSQLCommandLogClass, fSQLErrorLogClass);
end;
function TDAServerLog.AddSQLCommandLog(aSession: TROSession; const aCommand: IDASQLCommand;
anActualSQLText: string; aElapsedMilliseconds: Cardinal): TDASQLCommandLog;
begin
result := NIL;
if not Active then Exit;
result := fSQLCommandLogClass.Create(Self, aSession, aCommand, anActualSQLText, aElapsedMilliseconds);
fCriticalSQLCommands.Enter;
try
fSQLCommandLogs.Add(result);
if Assigned(fOnAddSQLCommandLog)
then fOnAddSQLCommandLog(Self, result);
finally
fCriticalSQLCommands.Leave;
end;
end;
function TDAServerLog.AddSQLErrorLog(aSession: TROSession; aError: Exception; const aCommand: IDASQLCommand;
aActualSQLText: string): TDASQLErrorLog;
begin
result := NIL;
if not Active then Exit;
result := fSQLErrorLogClass.Create(Self, aSession, aError, aCommand, aActualSQLText);
fCriticalSQLErrors.Enter;
try
fSQLErrorsLogs.Add(result);
if Assigned(OnAddSQLErrorLog)
then OnAddSQLErrorLog(Self, result);
finally
fCriticalSQLErrors.Leave;
end;
end;
function TDAServerLog.AddSessionLog(aSession: TROSession; aLoginInfo: TROComplexType): TDASessionLog;
begin
result := NIL;
if not Active then Exit;
result := fSessionLogClass.Create(Self, aSession, aLoginInfo);
fCriticalSessions.Enter;
try
fSessionsLogs.AddObject(GUIDToString(aSession.SessionID), result);
if Assigned(fOnAddSessionLog)
then fOnAddSessionLog(Self, result);
finally
fCriticalSessions.Leave;
end;
end;
procedure TDAServerLog.RemoveSessionLog(aSessionID: TGUID; aRemoveRelatedLogs: boolean);
var idx: integer;
removeRelated: boolean;
begin
fCriticalSessions.Enter;
try
idx := fSessionsLogs.IndexOf(GUIDToString(aSessionID));
if (idx>=0) then begin
removeRelated := aRemoveRelatedLogs;
if Assigned(fOnRemoveSessionLog)
then fOnRemoveSessionLog(Self, TDASessionLog(fSessionsLogs.Objects[idx]), removeRelated);
fSessionsLogs.Objects[idx].Free;
fSessionsLogs.Delete(idx);
{ Removes the entries associated to this session in the sql and errors lists }
if removeRelated then begin
ClearSQLCommandLogs(aSessionID);
ClearSQLErrorLogs(aSessionID);
end;
end;
finally
fCriticalSessions.Leave;
end;
end;
procedure TDAServerLog.RemoveSessionLog(aSession: TROSession; aRemoveRelatedLogs: boolean);
begin
RemoveSessionLog(aSession.SessionID, aRemoveRelatedLogs);
end;
function TDAServerLog.GetSQLCommandLogsCount: integer;
begin
result := fSQLCommandLogs.Count
end;
function TDAServerLog.GetSQLCommandLogs(Index: integer): TDASQLCommandLog;
begin
result := TDASQLCommandLog(fSQLCommandLogs[Index])
end;
function TDAServerLog.GetSQLErrorLogsCount: integer;
begin
result := fSQLErrorsLogs.Count
end;
function TDAServerLog.GetSQLErrorLogs(Index: integer): TDASQLErrorLog;
begin
result := TDASQLErrorLog(fSQLErrorsLogs[Index])
end;
function TDAServerLog.GetSessionLogsCount: integer;
begin
result := fSessionsLogs.Count
end;
function TDAServerLog.GetSessionLogs(Index: integer): TDASessionLog;
begin
result := TDASessionLog(fSessionsLogs.Objects[Index])
end;
procedure TDAServerLog.RegisterLogServer;
begin
if (_ServerLog<>NIL)
then raise Exception.Create('Only one instance of TDAServerLog is allowed');
_ServerLog := Self;
end;
procedure TDAServerLog.UnRegisterLogServer;
begin
_ServerLog := NIL;
end;
procedure TDAServerLog.ClearSQLCommandLogs;
begin
fCriticalSQLCommands.Enter;
try
fSQLCommandLogs.Clear;
finally
fCriticalSQLCommands.Leave;
end;
end;
procedure TDAServerLog.ClearSQLErrorLogs;
begin
fCriticalSQLErrors.Enter;
try
fSQLErrorsLogs.Clear;
finally
fCriticalSQLErrors.Leave;
end;
end;
procedure TDAServerLog.ClearSQLCommandLogs(aSessionID: TGUID);
var i: integer;
begin
fCriticalSQLCommands.Enter;
try
for i := fSQLCommandLogs.Count-1 downto 0 do
if IsEqualGUID(TDASQLCommandLog(fSQLCommandLogs[i]).SessionID, aSessionID)
then fSQLCommandLogs.Delete(i);
finally
fCriticalSQLCommands.Leave;
end;
end;
procedure TDAServerLog.ClearSQLErrorLogs(aSessionID: TGUID);
var i: integer;
begin
fCriticalSQLErrors.Enter;
try
for i := fSQLErrorsLogs.Count-1 downto 0 do
if IsEqualGUID(TDASQLErrorLog(fSQLErrorsLogs[i]).SessionID, aSessionID)
then fSQLErrorsLogs.Delete(i);
finally
fCriticalSQLErrors.Leave;
end;
end;
procedure TDAServerLog.ClearSessionLogs(aRemoveRelatedLogs: boolean);
var i: integer;
thisLog: TDASessionLog;
begin
fCriticalSessions.Enter;
try
for i := 0 to (fSessionsLogs.Count-1) do begin
thisLog := TDASessionLog(fSessionsLogs.Objects[i]);
if aRemoveRelatedLogs then begin
ClearSQLCommandLogs(thisLog.SessionID);
ClearSQLErrorLogs(thisLog.SessionID);
end;
thisLog.Free;
end;
fSessionsLogs.Clear;
finally
fCriticalSessions.Leave;
end;
end;
function TDAServerLog.FindSessionLog(aSession: TROSession): TDASessionLog;
begin
if (aSession<>NIL)
then result := FindSessionLog(aSession.SessionID)
else result := NIL;
end;
function TDAServerLog.FindSessionLog(aSessionID: TGUID): TDASessionLog;
var idx: integer;
begin
result := NIL;
idx := fSessionsLogs.IndexOf(GUIDToString(aSessionID));
if (idx>=0) then result := TDASessionLog(fSessionsLogs.Objects[idx]);
end;
procedure TDAServerLog.SaveToXML(aFileName: string);
var doc: IXMLDocument;
begin
doc := NewROXmlDocument;
doc.New('Log');
SaveToXML(doc);
doc.SaveToFile(aFileName);
end;
procedure TDAServerLog.SaveToXML(const aXMLDocument: IXMLDocument);
var i: integer;
sessionLog: TDASessionLog;
sqlLog: TDASQLCommandLog;
errorLog: TDASQLErrorLog;
begin
with TROXMLSerializer.Create(pointer(aXMLDocument.DocumentNode)) do try
SerializationOptions := [xsoSendUntyped];
for i := 0 to SessionLogsCount-1 do begin
sessionLog := SessionLogs[i];
Write(sessionLog.ClassName, sessionLog.ClassInfo, sessionLog);
end;
for i := 0 to SQLCommandLogsCount-1 do begin
sqlLog := SQLCommandLogs[i];
Write(sqlLog.ClassName, sqlLog.ClassInfo, sqlLog);
end;
for i := 0 to SQLErrorLogsCount-1 do begin
errorLog := SQLErrorLogs[i];
Write(errorLog.ClassName, errorLog.ClassInfo, errorLog);
end;
finally
Free;
end;
end;
initialization
RegisterROClass(TDASessionLog);
RegisterROClass(TDASQLCommandLog);
RegisterROClass(TDASQLErrorLog);
finalization
FreeAndNIL(_ServerLog);
UnRegisterROClass(TDASessionLog);
UnRegisterROClass(TDASQLCommandLog);
UnRegisterROClass(TDASQLErrorLog);
end.