SHARE
TWEET

CustomDebugOut.pas

LarsFosdal Oct 15th, 2014 (edited) 340 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit CustomDebugOut;
  2.  
  3. ///  Simple override for Windows.OutputDebugString which adds a timestamp, thread id and memory
  4. ///  Written by Lars Fosdal, Tine SA, 01 FEB 2010 http://plus.lars.fosdal.com
  5.  
  6. interface
  7. uses
  8.   Windows, SysUtils, DateUtils, SyncObjs;
  9.  
  10. const
  11.   /// <summary> For significant system events </summary>
  12.   SysEvent = '### ';
  13.   /// <summary> For serious low level error log entries  </summary>
  14.   BadShit = '#BAD: ';
  15.   /// <summary> For unexpected error log entries  </summary>
  16.   WTF = '#WTF: ';
  17.  
  18.  
  19. {$ifdef CI} // Defined in the project options - Should be set if app is Continuous Integration Tests
  20. type
  21.   TOnDebugOutput = reference to procedure(const aThreadId: Cardinal; const aStr: pChar);
  22.   function HookOutputDebug(const aOnDebugOutput: TOnDebugOutput): TOnDebugOutput;
  23.   procedure UnhookOutputDebug;
  24. {$endif}
  25.  
  26.   procedure OutputDebugString(aStr:PChar); {$ifndef CI} {Inline;} {$endif} overload;
  27.   procedure OutputDebugString(const aStr:String); {$ifndef CI} Inline; {$endif} overload;
  28.  
  29. implementation
  30.  
  31. var
  32.   CustomDebugCriticalSection: TCriticalSection;
  33.  
  34. {$ifdef CI}
  35. threadvar
  36.   FOnOutputDebug: TOnDebugOutput;
  37.  
  38. function HookOutputDebug(const aOnDebugOutput: TOnDebugOutput): TOnDebugOutput;
  39. begin
  40.   Result := FOnOutputDebug;
  41.   FOnOutputDebug := aOnDebugOutput;
  42. end;
  43.  
  44. procedure UnhookOutputDebug;
  45. begin
  46.   FOnOutputDebug := nil;
  47. end;
  48.  
  49. procedure CallOutputDebugHook(const aThreadId: Cardinal; const aStr: pChar);
  50. begin
  51.   if Assigned(FOnOutputDebug)
  52.    then FOnOutputDebug(aThreadId, aStr);
  53. end;
  54. {$endif}
  55.  
  56. function MemoryUsed: cardinal; Inline;
  57. var
  58.   MMS: TMemoryManagerState;
  59.   Block: TSmallBlockTypeState;
  60. begin
  61.   GetMemoryManagerState(MMS);
  62.   Result := MMS.TotalAllocatedMediumBlockSize + MMS.TotalAllocatedLargeBlockSize;
  63.   for Block in MMS.SmallBlockTypeStates
  64.    do Result := Result + (Block.UseableBlockSize * Block.AllocatedBlockCount);
  65.   Result := Result DIV 1024;
  66. end;
  67.  
  68. function MemoryUsedInK:String; Inline;
  69. begin
  70.   Result := ' '+ IntToStr(MemoryUsed) +'k';
  71. end;
  72.  
  73. procedure OutputDebugString(aStr:PChar); {$ifndef CI} {Inline;} {$endif}
  74. var
  75.   tid: Cardinal;
  76. begin
  77.   CustomDebugCriticalSection.Acquire;
  78.   try
  79.     tid := GetCurrentThreadId;
  80.     Windows.OutputDebugString(pChar('{'
  81.      + FormatDateTime('hh:nn:ss,zzz ', Now) // time
  82.      + '('+IntToStr(tid)+')'           // thread
  83.      + MemoryUsedInK   // memory in k
  84.      + '} ' + aStr));
  85.   {$ifdef CI}
  86.     CallOutputDebugHook(tid, aStr);
  87.   {$endif}
  88.   finally
  89.     CustomDebugCriticalSection.Release;
  90.   end;
  91. end;
  92.  
  93. procedure OutputDebugString(const aStr:String); {$ifndef CI} Inline; {$endif}
  94. begin
  95.   OutputDebugString(pChar(aStr));
  96. end;
  97.  
  98. initialization
  99.   CustomDebugCriticalSection := TCriticalSection.Create;
  100. {$ifdef CI}
  101.   FOnOutputDebug := nil;
  102. {$endif}
  103.   OutputDebugString(SysEvent + 'START' + FormatDateTime(' dd mmm yyyy ', Now) + ParamStr(0));
  104. finalization
  105. {$ifdef CI}
  106.   FOnOutputDebug := nil;
  107. {$endif}
  108.   OutputDebugString(SysEvent + 'STOP' + FormatDateTime(' dd mmm yyyy ', Now) + ParamStr(0));
  109.   CustomDebugCriticalSection.Free;
  110. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top