// *************************************************************************** } // // LoggerPro // // Copyright (c) 2010-2024 Daniele Teti // // https://github.com/danieleteti/loggerpro // // Contributors for this file: // Fulgan - https://github.com/Fulgan // // *************************************************************************** // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. // You may obtain a copy of the License at // // http://www.apache.org/licenses/LICENSE-2.0 // // Unless required by applicable law or agreed to in writing, software // distributed under the License is distributed on an "AS IS" BASIS, // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. // See the License for the specific language governing permissions and // limitations under the License. // // *************************************************************************** unit LoggerPro.ConsoleAppender; interface uses Classes, SysUtils, LoggerPro, SyncObjs; type /// TLoggerProConsoleAppender /// This class creates a new console (if needed) when setup. /// Warning: If the application is of type GUI and it is started from a console, /// this will NOT log to the calling console but create a new one. /// This is because the way cmd.exe works: if the application is of type GUI, /// then is immediately detaches from cmd.exe which doesn't wait. This means that /// there is never a console to attach to except if a new console is created /// elsewhere in the app. /// In case this class is used from a console, then there is no guarantee that /// the messages will be /// displayed in chronological order. /// TLoggerProConsoleAppender = class(TLoggerProAppenderBase) strict private class var FLock: TCriticalSection; // used to prevent syncroneous operations to run at the same time class var FConsoleAllocated: Int64; // used to ensure one and only one console is created class constructor Create; // allocate global vars class destructor Destroy; protected fColors: array [TLogType.Debug .. TLogType.Fatal] of Integer; fSavedColors: Integer; procedure SetColor(const Color: Integer); procedure SetupColorMappings; virtual; public procedure Setup; override; procedure TearDown; override; procedure WriteLog(const aLogItem: TLogItem); override; end; // for some reason, AttachConsole has been left out of Winapi.windows.pas function AttachConsole(PID: Cardinal): LongBool; stdcall; implementation { TLoggerProConsoleAppender } uses Winapi.Windows, Winapi.Messages; // for some reason, AttachConsole has been left out of Winapi.windows.pas const ATTACH_PARENT_PROCESS = Cardinal(-1); function AttachConsole; external kernel32 name 'AllocConsole'; const { FOREGROUND COLORS - CAN BE COMBINED } FOREGROUND_BLUE = 1; { text color blue. } FOREGROUND_GREEN = 2; { text color green } FOREGROUND_RED = 4; { text color red } FOREGROUND_INTENSITY = 8; { text color is intensified } { BACKGROUND COLORS - CAN BE COMBINED } BACKGROUND_BLUE = $10; { background color blue } BACKGROUND_GREEN = $20; { background color green } BACKGROUND_RED = $40; { background color red. } BACKGROUND_INTENSITY = $80; { background color is intensified } procedure TLoggerProConsoleAppender.SetColor(const Color: Integer); begin SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), Color); end; function GetCurrentColors: Integer; var info: CONSOLE_SCREEN_BUFFER_INFO; begin Result := -1; if GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), info) then begin Result := info.wAttributes; end; end; procedure TLoggerProConsoleAppender.Setup; begin inherited; if TInterlocked.read(TLoggerProConsoleAppender.FConsoleAllocated) < 2 then begin TLoggerProConsoleAppender.FLock.Enter; try if TInterlocked.Increment(TLoggerProConsoleAppender.FConsoleAllocated) = 1 then begin SetupColorMappings; // Attempt to attach to the parent (if there is already a console allocated) if not IsConsole then begin if not AttachConsole(ATTACH_PARENT_PROCESS) then begin AllocConsole; // No console allocated, create a new one end; end; fSavedColors := GetCurrentColors; TInterlocked.Increment(TLoggerProConsoleAppender.FConsoleAllocated); end; finally TLoggerProConsoleAppender.FLock.Leave; end; end; end; procedure TLoggerProConsoleAppender.SetupColorMappings; begin fColors[TLogType.Debug] := FOREGROUND_GREEN; fColors[TLogType.Info] := FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED; fColors[TLogType.Warning] := FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_INTENSITY; fColors[TLogType.Error] := FOREGROUND_RED or FOREGROUND_INTENSITY; fColors[TLogType.Fatal] := FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_INTENSITY; end; procedure TLoggerProConsoleAppender.TearDown; begin if fSavedColors > -1 then SetColor(fSavedColors) else SetColor(FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED); end; procedure TLoggerProConsoleAppender.WriteLog(const aLogItem: TLogItem); var lText: string; lColor: Integer; begin lColor := fColors[aLogItem.LogType]; lText := FormatLog(aLogItem); TLoggerProConsoleAppender.FLock.Enter; try SetColor(lColor); Writeln(lText); finally TLoggerProConsoleAppender.FLock.Leave; end; end; class constructor TLoggerProConsoleAppender.Create; begin TLoggerProConsoleAppender.FLock := TCriticalSection.Create; TLoggerProConsoleAppender.FConsoleAllocated := 0; end; class destructor TLoggerProConsoleAppender.Destroy; begin // make sure all code try TLoggerProConsoleAppender.FLock.Enter; FreeAndNil(TLoggerProConsoleAppender.FLock); except // No exception checking here or the app might blow up with a RTE 217 end; end; end.