在用 Delphi 编写的服务器上捕获 OutputDebugString() 调用

Question

我有一个用 Delphi 编写的服务器，我想添加一个调试记录器，以便它可以在部署时记录传递给 Windows.OutputDebugString() 的消息，以便客户端可以在出现问题时向我发送日志。最后，我想要类似于DebugView 的功能，但内置在服务器程序本身中。

我了解 OutputDebugString 的工作原理，方法是写入共享内存文件并使用系统范围的事件来同步程序及其调试器，我有 found solutions in C# 和 C++，但还不能翻译这些解决方案到德尔福。

我最大的问题是不知道如何与 Delphi 中的 DBWIN_BUFFER_READY 和 DBWIN_DATA_READY 同步事件进行交互，或者如何引用 OutputDebugString 写入的特定内存映射文件“DBWIN_BUFFER”。

另外我找到了实现自己的方法调用而不是 Windows.OutputDebugString() 的解决方案，但是程序已经有数百个调用，无论是在我们编写的代码和我们添加的第三方模块中，所以这些不是一种选择。

Answer 1

您链接到的 C++ 代码可以翻译成 Delphi，如下所示：

//////////////////////////////////////////////////////////////
//
//         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

你的解决方案是错误的。

提示：此函数列在调试函数下，名称中带有“Debug”。

想象一下what if two programs did this。 OutputDebugString 是一个全局函数。它从任何进程向调试器发送一个字符串。如果两个程序使用 OutputDebugString 作为他们的日志记录解决方案 - 你会从两个进程的同时输出中得到一团糟，并且每个日志将与其他日志混合。

来自 MSDN 的引用（作为您的解决方案错误的额外证据）：

应用程序应该发送非常少的调试输出，并为用户提供一种启用或禁用其使用的方法。要提供更详细的跟踪，请参阅事件跟踪。

换句话说，OutputDebugString 是用于开发构建的调试解决方案；它不是一个日志系统。

使用这个（伪代码来说明这个想法）：

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.

只需将此单元添加到每个其他单元的 uses 子句 - 您将自动捕获“输出 OutputDebugString”，而无需更改源代码。