Question

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

我理解OutputDebugString如何通过写入共享内存文件并使用系统范围的事件来同步程序及其调试器来工作，我有found solutions in C#和C++，但还没有能够将这些解决方案转换为Delphi。

我最大的问题是不知道如何与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是一个全局函数。它从ANY进程向调试器发送一个字符串。如果两个程序使用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”，而无需更改源代码。

捕获OutputDebugString（）调用用Delphi编写的服务器

2 个答案: