Capturing OutputDebugString() calls on a server written in 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.