mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 13:29:14 +02:00
+ 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:
parent
f39f8d0f1a
commit
dc48872552
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user