Capturing OutputDebugString() calls on a server written in Delphi - delphi

Question

I have a server written in Delphi that I would like to add a debug logger to so it can log messages passed to Windows.OutputDebugString() while it is deployed, so clients can send me the log when there are issues. In the end, I want functionality similar to DebugView, but built into the server program itself.
I understand how the OutputDebugString works by writing to a shared memory file and using system wide events to synchronize the program and its debugger, and I have found solutions in C# and C++, but have yet to be able to translate those solutions to Delphi.
My largest problem is not knowing how to interact with the DBWIN_BUFFER_READY and DBWIN_DATA_READY synchronization events with Delphi, or how to reference the specific memory mapped file "DBWIN_BUFFER" that OutputDebugString writes to.
Additionally I have found solutions that implement their own method call instead of Windows.OutputDebugString(), but the program already has hundreds of calls, both in the code we have written and third-party modules we have added in, so these are not an option.

Answer 1

The C++ code you linked to can be translated to Delphi as follows:
//////////////////////////////////////////////////////////////
//
// File: WinDebugMonitor.pas
// Description: Interface of class TWinDebugMonitor
// Created: 2007-12-6
// Author: Ken Zhang
// E-Mail: cpp.china#hotmail.com
//
// Translated: 2015-02-13
// Translator: Remy Lebeau
// E-Mail: remy#lebeausoftware.org
//
//////////////////////////////////////////////////////////////
unit WinDebugMonitor;
interface
uses
Windows;
type
PDbWinBuffer = ^DbWinBuffer;
DbWinBuffer = record
dwProcessId: DWORD;
data: array[0..(4096-sizeof(DWORD))-1] of AnsiChar;
end;
TWinDebugMonitor = class
private
m_hDBWinMutex: THandle;
m_hDBMonBuffer: THandle;
m_hEventBufferReady: THandle;
m_hEventDataReady: THandle;
m_hWinDebugMonitorThread: THandle;
m_bWinDebugMonStopped: Boolean;
m_pDBBuffer: PDbWinBuffer;
function Initialize: DWORD;
procedure Uninitialize;
function WinDebugMonitorProcess: DWORD;
public
constructor Create;
destructor Destroy; override;
procedure OutputWinDebugString(const str: PAnsiChar); virtual;
end;
implementation
// ----------------------------------------------------------------------------
// PROPERTIES OF OBJECTS
// ----------------------------------------------------------------------------
// NAME | DBWinMutex DBWIN_BUFFER_READY DBWIN_DATA_READY
// ----------------------------------------------------------------------------
// TYPE | Mutex Event Event
// ACCESS | All All Sync
// INIT STATE | ? Signaled Nonsignaled
// PROPERTY | ? Auto-Reset Auto-Reset
// ----------------------------------------------------------------------------
constructor TWinDebugMonitor.Create;
begin
inherited;
if Initialize() <> 0 then begin
OutputDebugString('TWinDebugMonitor.Initialize failed.'#10);
end;
end;
destructor TWinDebugMonitor.Destroy;
begin
Uninitialize;
inherited;
end;
procedure TWinDebugMonitor.OutputWinDebugString(const str: PAnsiChar);
begin
end;
function WinDebugMonitorThread(pData: Pointer): DWORD; stdcall;
var
_Self: TWinDebugMonitor;
begin
_Self = TWinDebugMonitor(pData);
if _Self <> nil then begin
while not _Self.m_bWinDebugMonStopped do begin
_Self.WinDebugMonitorProcess;
end;
end;
Result := 0;
end;
function TWinDebugMonitor.Initialize: DWORD;
begin
SetLastError(0);
// Mutex: DBWin
// ---------------------------------------------------------
m_hDBWinMutex := OpenMutex(MUTEX_ALL_ACCESS, FALSE, 'DBWinMutex');
if m_hDBWinMutex = 0 then begin
Result := GetLastError;
Exit;
end;
// Event: buffer ready
// ---------------------------------------------------------
m_hEventBufferReady := OpenEvent(EVENT_ALL_ACCESS, FALSE, 'DBWIN_BUFFER_READY');
if m_hEventBufferReady = 0 then begin
m_hEventBufferReady = CreateEvent(nil, FALSE, TRUE, 'DBWIN_BUFFER_READY');
if m_hEventBufferReady = 0 then begin
Result := GetLastError;
Exit;
end;
end;
// Event: data ready
// ---------------------------------------------------------
m_hEventDataReady := OpenEvent(SYNCHRONIZE, FALSE, 'DBWIN_DATA_READY');
if m_hEventDataReady = 0 then begin
m_hEventDataReady := CreateEvent(nil, FALSE, FALSE, 'DBWIN_DATA_READY');
if m_hEventDataReady = 0 then begin
Result := GetLastError;
end;
end;
// Shared memory
// ---------------------------------------------------------
m_hDBMonBuffer := OpenFileMapping(FILE_MAP_READ, FALSE, 'DBWIN_BUFFER');
if m_hDBMonBuffer = 0 then begin
begin
m_hDBMonBuffer := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(DbWinBuffer), 'DBWIN_BUFFER');
if m_hDBMonBuffer = 0 then begin
Result := GetLastError;
Exit;
end;
end;
m_pDBBuffer := PDbWinBuffer(MapViewOfFile(m_hDBMonBuffer, SECTION_MAP_READ, 0, 0, 0));
if m_pDBBuffer = nil then begin
Result := GetLastError;
Exit;
end;
// Monitoring thread
// ---------------------------------------------------------
m_bWinDebugMonStopped := False;
m_hWinDebugMonitorThread := CreateThread(nil, 0, #WinDebugMonitorThread, Self, 0, nil);
if m_hWinDebugMonitorThread = 0 then begin
m_bWinDebugMonStopped := True;
Result := GetLastError;
Exit;
end;
// set monitor thread's priority to highest
// ---------------------------------------------------------
SetPriorityClass(GetCurrentProcess(), REALTIME_PRIORITY_CLASS);
SetThreadPriority(m_hWinDebugMonitorThread, THREAD_PRIORITY_TIME_CRITICAL);
Result := 0;
end;
procedure TWinDebugMonitor.Uninitialize;
begin
if m_hWinDebugMonitorThread <> 0 then begin
m_bWinDebugMonStopped := True;
WaitForSingleObject(m_hWinDebugMonitorThread, INFINITE);
CloseHandle(m_hWinDebugMonitorThread);
m_hWinDebugMonitorThread := 0;
end;
if m_hDBWinMutex <> 0 then begin
CloseHandle(m_hDBWinMutex);
m_hDBWinMutex := 0;
end;
if m_pDBBuffer <> nil then begin
UnmapViewOfFile(m_pDBBuffer);
m_pDBBuffer := nil;
end;
if m_hDBMonBuffer <> 0 then begin
CloseHandle(m_hDBMonBuffer);
m_hDBMonBuffer := 0;
end;
if m_hEventBufferReady <> 0 then begin
CloseHandle(m_hEventBufferReady);
m_hEventBufferReady := 0;
end;
if m_hEventDataReady <> 0 then begin
CloseHandle(m_hEventDataReady);
m_hEventDataReady := 0;
end;
end;
function TCWinDebugMonitor.WinDebugMonitorProcess: DWORD;
const
TIMEOUT_WIN_DEBUG = 100;
begin
// wait for data ready
Result := WaitForSingleObject(m_hEventDataReady, TIMEOUT_WIN_DEBUG);
if Result = WAIT_OBJECT_0 then begin
OutputWinDebugString(m_pDBBuffer^.data);
// signal buffer ready
SetEvent(m_hEventBufferReady);
end;
end;
program Monitor;
{$APPTYPE CONSOLE}
{$R *.res}
uses
WinDebugMonitor;
type
Monitor = class(TWinDebugMonitor)
public
procedure OutputWinDebugString(const str: PAnsiChar); override;
end;
procedure Monitor.OutputWinDebugString(const str: PAnsiChar);
begin
Write(str);
end;
var
mon: Monitor;
begin
WriteLn('Win Debug Monitor Tool');
WriteLn('----------------------');
mon := Monitor.Create;
try
ReadLn;
finally
mon.Free;
end;
end.
program Output;
{$APPTYPE CONSOLE}
{$R *.res}
uses
SysUtils, Windows, Messages;
var
hConsoleInput: THandle;
function KeyPressed: boolean;
var
NumberOfEvents: Integer;
begin
GetNumberOfConsoleInputEvents(hConsoleInput, NumberOfEvents);
Result := NumberOfEvents > 0;
end;
procedure KeyInit;
var
mode: Integer;
begin
// get input file handle
Reset(Input);
hConsoleInput := TTextRec(Input).Handle;
// checks/sets so mouse input does not work
SetActiveWindow(0);
GetConsoleMode(hConsoleInput, mode);
if (mode and ENABLE_MOUSE_INPUT) = ENABLE_MOUSE_INPUT then
SetConsoleMode(hConsoleInput, mode xor ENABLE_MOUSE_INPUT);
end;
var
i: Integer;
buf: AnsiString;
begin
KeyInit;
WriteLn('Press any key to stop calling OutputDebugString......');
i := 0;
while not KeyPressed do
begin
Inc(i);
buf := Format('Message from process %d, msg id: %d'#10, [ GetCurrentProcessId(), I]);
OutputDebugStringA(PAnsiChar(buf));
end;
Writeln('Total ', i, ' messages sent.');
end.

Answer 2

Your solution is wrong.
Hint: This function is listed under functions for debugging, and it has "Debug" in its name.
Imagine what if two programs did this. OutputDebugString is a global function. It sends a string from ANY process to the debugger. If two programs would use OutputDebugString as their logging solution - you will get a mess from simultaneous output from two processes, and each log will be mixed with other.
Quote from MSDN (as additional proof that your solution is wrong):
Applications should send very minimal debug output and provide a way for the user to enable or disable its use. To provide more detailed tracing, see Event Tracing.
In other words, OutputDebugString is a debugging solution for development builds; it is not a logging system.
Use this (pseudo-code to illustrate the idea):
unit DebugTools;
interface
procedure OutputDebugString(const AStr: String);
implementation
procedure OutputDebugString(const AStr: String);
begin
if IsDebuggerPresent then
Windows.OutputDebugString(PChar(AStr))
else
begin
CritSect.Enter;
try
GlobalLog.Add(AStr);
finally
CritSect.Leave;
end;
end;
end;
end.
Just add this unit to the uses clause for each of your other units - and you will automatically capture "output OutputDebugString" without need to change source code.