Pasted

unit CustomDebugOut;
 
///  Simple override for Windows.OutputDebugString which adds a timestamp, thread id and memory
///  Written by Lars Fosdal, Tine SA, 01 FEB 2010 http://plus.lars.fosdal.com
 
interface
uses
  Windows, SysUtils, DateUtils, SyncObjs;
 
const
  /// <summary> For significant system events </summary>
  SysEvent = '### ';
  /// <summary> For serious low level error log entries  </summary>
  BadShit = '#BAD: ';
  /// <summary> For unexpected error log entries  </summary>
  WTF = '#WTF: ';
 
 
{$ifdef CI} // Defined in the project options - Should be set if app is Continuous Integration Tests
type
  TOnDebugOutput = reference to procedure(const aThreadId: Cardinal; const aStr: pChar);
  function HookOutputDebug(const aOnDebugOutput: TOnDebugOutput): TOnDebugOutput;
  procedure UnhookOutputDebug;
{$endif}
 
  procedure OutputDebugString(aStr:PChar); {$ifndef CI} {Inline;} {$endif} overload;
  procedure OutputDebugString(const aStr:String); {$ifndef CI} Inline; {$endif} overload;
 
implementation
 
var
  CustomDebugCriticalSection: TCriticalSection;
 
{$ifdef CI}
threadvar
  FOnOutputDebug: TOnDebugOutput;
 
function HookOutputDebug(const aOnDebugOutput: TOnDebugOutput): TOnDebugOutput;
begin
  Result := FOnOutputDebug;
  FOnOutputDebug := aOnDebugOutput;
end;
 
procedure UnhookOutputDebug;
begin
  FOnOutputDebug := nil;
end;
 
procedure CallOutputDebugHook(const aThreadId: Cardinal; const aStr: pChar);
begin
  if Assigned(FOnOutputDebug)
   then FOnOutputDebug(aThreadId, aStr);
end;
{$endif}
 
function MemoryUsed: cardinal; Inline;
var
  MMS: TMemoryManagerState;
  Block: TSmallBlockTypeState;
begin
  GetMemoryManagerState(MMS);
  Result := MMS.TotalAllocatedMediumBlockSize + MMS.TotalAllocatedLargeBlockSize;
  for Block in MMS.SmallBlockTypeStates
   do Result := Result + (Block.UseableBlockSize * Block.AllocatedBlockCount);
  Result := Result DIV 1024;
end;
 
function MemoryUsedInK:String; Inline;
begin
  Result := ' '+ IntToStr(MemoryUsed) +'k';
end;
 
procedure OutputDebugString(aStr:PChar); {$ifndef CI} {Inline;} {$endif}
var
  tid: Cardinal;
begin
  CustomDebugCriticalSection.Acquire;
  try
    tid := GetCurrentThreadId;
    Windows.OutputDebugString(pChar('{'
     + FormatDateTime('hh:nn:ss,zzz ', Now) // time
     + '('+IntToStr(tid)+')'           // thread
     + MemoryUsedInK   // memory in k
     + '} ' + aStr));
  {$ifdef CI}
    CallOutputDebugHook(tid, aStr);
  {$endif}
  finally
    CustomDebugCriticalSection.Release;
  end;
end;
 
procedure OutputDebugString(const aStr:String); {$ifndef CI} Inline; {$endif}
begin
  OutputDebugString(pChar(aStr));
end;
 
initialization
  CustomDebugCriticalSection := TCriticalSection.Create;
{$ifdef CI}
  FOnOutputDebug := nil;
{$endif}
  OutputDebugString(SysEvent + 'START' + FormatDateTime(' dd mmm yyyy ', Now) + ParamStr(0));
finalization
{$ifdef CI}
  FOnOutputDebug := nil;
{$endif}
  OutputDebugString(SysEvent + 'STOP' + FormatDateTime(' dd mmm yyyy ', Now) + ParamStr(0));
  CustomDebugCriticalSection.Free;
end.