+ add support for logging to StdOut or StdErr instead of a file or system output; if the specified output is not opened an exception will be thrown

git-svn-id: trunk@48458 -
This commit is contained in:
svenbarth 2021-01-30 20:13:02 +00:00
parent f39f8d0f1a
commit dc48872552

View File

@ -23,7 +23,7 @@ uses SysUtils,Classes;
Type Type
TEventLog = Class; TEventLog = Class;
TLogType = (ltSystem,ltFile); TLogType = (ltSystem,ltFile,ltStdOut,ltStdErr);
TLogCodeEvent = Procedure (Sender : TObject; Var Code : DWord) of Object; TLogCodeEvent = Procedure (Sender : TObject; Var Code : DWord) of Object;
TLogCategoryEvent = Procedure (Sender : TObject; Var Code : Word) of Object; TLogCategoryEvent = Procedure (Sender : TObject; Var Code : Word) of Object;
@ -52,10 +52,13 @@ Type
procedure DeActivateLog; procedure DeActivateLog;
procedure ActivateFileLog; procedure ActivateFileLog;
procedure SetFileName(const Value: String); procedure SetFileName(const Value: String);
procedure ActivateIOLog;
procedure ActivateSystemLog; procedure ActivateSystemLog;
function DefaultFileName: String; function DefaultFileName: String;
function FormatLogMessage(EventType : TEventType; const Msg: String): String;
procedure WriteFileLog(EventType : TEventType; const Msg: String); procedure WriteFileLog(EventType : TEventType; const Msg: String);
procedure WriteSystemLog(EventType: TEventType; const Msg: String); procedure WriteSystemLog(EventType: TEventType; const Msg: String);
procedure WriteIOLog(EventType: TEventType; const Msg: String; var OutFile: TextFile);
procedure DeActivateFileLog; procedure DeActivateFileLog;
procedure DeActivateSystemLog; procedure DeActivateSystemLog;
procedure CheckIdentification; procedure CheckIdentification;
@ -114,6 +117,8 @@ Resourcestring
SLogDebug = 'Debug'; SLogDebug = 'Debug';
SLogCustom = 'Custom (%d)'; SLogCustom = 'Custom (%d)';
SErrLogFailedMsg = 'Failed to log entry (Error: %s)'; SErrLogFailedMsg = 'Failed to log entry (Error: %s)';
SErrLogOpenStdOut = 'Standard Output not available for logging';
SErrLogOpenStdErr = 'Standard Error not available for logging';
implementation implementation
@ -201,20 +206,30 @@ begin
Case FlogType of Case FlogType of
ltFile : WriteFileLog(EventType,Msg); ltFile : WriteFileLog(EventType,Msg);
ltSystem : WriteSystemLog(EventType,Msg); ltSystem : WriteSystemLog(EventType,Msg);
ltStdOut : WriteIOLog(EventType,Msg,StdOut);
ltStdErr : WriteIOLog(EventType,Msg,StdErr);
end; end;
end; end;
procedure TEventLog.WriteFileLog(EventType : TEventType; const Msg : String); function TEventLog.FormatLogMessage(EventType : TEventType; const Msg: String): String;
Var Var
S,TS,T : String; TS,T : String;
begin begin
If FTimeStampFormat='' then If FTimeStampFormat='' then
FTimeStampFormat:='yyyy-mm-dd hh:nn:ss.zzz'; FTimeStampFormat:='yyyy-mm-dd hh:nn:ss.zzz';
TS:=FormatDateTime(FTimeStampFormat,Now); TS:=FormatDateTime(FTimeStampFormat,Now);
T:=EventTypeToString(EventType); T:=EventTypeToString(EventType);
S:=Format('%s [%s %s] %s%s',[Identification,TS,T,Msg,LineEnding]); Result:=Format('%s [%s %s] %s',[Identification,TS,T,Msg]);
end;
procedure TEventLog.WriteFileLog(EventType : TEventType; const Msg : String);
Var
S : String;
begin
S:=FormatLogMessage(EventType, Msg)+LineEnding;
try try
FStream.WriteBuffer(S[1],Length(S)); FStream.WriteBuffer(S[1],Length(S));
S:=''; S:='';
@ -226,6 +241,11 @@ begin
Raise ELogError.CreateFmt(SErrLogFailedMsg,[S]); Raise ELogError.CreateFmt(SErrLogFailedMsg,[S]);
end; end;
procedure TEventLog.WriteIOLog(EventType: TEventType; const Msg: String; var OutFile: TextFile);
begin
Writeln(OutFile,FormatLogMessage(EventType,Msg));
end;
procedure TEventLog.Log(const Fmt: String; Args: array of const); procedure TEventLog.Log(const Fmt: String; Args: array of const);
begin begin
Log(Format(Fmt,Args)); Log(Format(Fmt,Args));
@ -249,6 +269,8 @@ begin
Case FLogType of Case FLogType of
ltFile : ActivateFileLog; ltFile : ActivateFileLog;
ltSystem : ActivateSystemLog; ltSystem : ActivateSystemLog;
ltStdOut,
ltStdErr : ActivateIOLog;
end; end;
end; end;
@ -258,6 +280,8 @@ begin
Case FLogType of Case FLogType of
ltFile : DeActivateFileLog; ltFile : DeActivateFileLog;
ltSystem : DeActivateSystemLog; ltSystem : DeActivateSystemLog;
{ nothing to do here }
ltStdOut,ltStdErr : ;
end; end;
end; end;
@ -279,6 +303,24 @@ begin
FStream.Seek(0,soFromEnd); FStream.Seek(0,soFromEnd);
end; end;
Procedure TEventLog.ActivateIOLog;
var
errmsg: String;
m: LongInt;
begin
if FLogtype = ltStdOut then begin
m := TextRec(StdOut).Mode;
errmsg := SErrLogOpenStdOut;
end else begin
m := TextRec(StdErr).Mode;
errmsg := SErrLogOpenStdErr;
end;
if (m <> fmOutput) and (m <> fmAppend) then
raise ELogError.Create(errmsg);
end;
Procedure TEventLog.DeActivateFileLog; Procedure TEventLog.DeActivateFileLog;
begin begin