Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement