bl.OGware

infrequent grumblings of a software engineer and then some… (also some Delphi programming)

Archive for April, 2010

Interface unit for sending debug messages to SysInternals ProcessMonitor

Posted by tier777 on 2010-04-15

The latest version of SysInternals‘ excellent ProcessMonitor is now able to receive custom debug log messages and display them right in between the I/O logs.

Even though I still don’t quite get the rationale for the need to create a new API for this (in contrast to simply merging in the functionality of DebugView) I went straight ahead and converted the API to Delphi.

This should work with Delphi 6 and later. I successfully tested with Delphi 2007, 2009 and 2010.

(Update: the originally posted version did actually not work with Delphi 2007 or earlier because I had inexplicably overlooked “that Unicode thing”… Thanks to GunSmoker for pointing that out! Using $ifdef UNICODE and WideString is a cheap cop-out, I know – but it works)

Enjoy:

unit ProcMonDebugOutput;

interface

uses
  Windows;

type
  TProcessMonitorLogger = class
  private
    const
//      FILE_WRITE_ACCESS           = $00000002;
//      METHOD_BUFFERED             = $00000000;
//      FILE_DEVICE_PROCMON_LOG     = $00009535;
//      IOCTL_EXTERNAL_LOG_DEBUGOUT = CTL_CODE(FILE_DEVICE_PROCMON_LOG,
//                                             $81,
//                                             METHOD_BUFFERED,
//                                             FILE_WRITE_ACCESS);
      IOCTL_EXTERNAL_LOG_DEBUGOUT = $95358204;
    class var
      FDevice: THandle; // = INVALID_HANDLE_VALUE
    class function Open(): THandle;
    class procedure Close();
    {$IF CompilerVersion >= 21}
    class constructor Create;
    class destructor Destroy;
    {$IFEND}
  public
    class function Output(const AOutputString: {$ifdef UNICODE}String{$else}WideString{$endif}): Boolean;
  end;
  PML = TProcessMonitorLogger;

implementation

{ TProcessMonitorLogger }

//function CTL_CODE(const ADevType, AFunc, AMethod, AAccess: Cardinal): Cardinal; inline;
//begin
//  Result := (ADevType shl 16) or (AAccess shl 14) or (AFunc shl 2) or AMethod;
//end;

{$IF CompilerVersion >= 21}
class constructor TProcessMonitorLogger.Create;
begin
  FDevice := INVALID_HANDLE_VALUE;
end;

class destructor TProcessMonitorLogger.Destroy;
begin
  Close();
end;
{$IFEND}

class procedure TProcessMonitorLogger.Close;
begin
  if INVALID_HANDLE_VALUE <> FDevice then
    begin
      CloseHandle(FDevice);
      FDevice := INVALID_HANDLE_VALUE;
    end;
end;

class function TProcessMonitorLogger.Open(): THandle;
begin
  if INVALID_HANDLE_VALUE = FDevice then
    FDevice := CreateFile('\\.\Global\ProcmonDebugLogger',
                            GENERIC_READ or GENERIC_WRITE,
                            FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
                            nil,
                            OPEN_EXISTING,
                            FILE_ATTRIBUTE_NORMAL,
                            0);
  Result := FDevice;
end;

class function TProcessMonitorLogger.Output(const AOutputString: {$ifdef UNICODE}String{$else}WideString{$endif}): Boolean;
var
  lProcMonHwnd: THandle;
  lInputLength: Cardinal;
  lOutputLength: Cardinal;
  lLastError: Cardinal;
begin
  Result := False;
  if AOutputString = '' then
    SetLastError(ERROR_INVALID_PARAMETER)
  else
    begin
      lProcMonHwnd := Open();
      if lProcMonHwnd <> INVALID_HANDLE_VALUE then
        begin
          lInputLength := Length(AOutputString) * SizeOf(WideChar);
          lOutputLength := 0;
          Result := DeviceIoControl(lProcMonHwnd,
                                    IOCTL_EXTERNAL_LOG_DEBUGOUT,
                                    PWideChar(AOutputString),
                                    lInputLength,
                                    nil,
                                    0,
                                    lOutputLength,
                                    nil);
          if not Result then
            begin
              lLastError := GetLastError();
              if lLastError = ERROR_INVALID_PARAMETER then
                SetLastError(ERROR_WRITE_FAULT);
            end;
        end
      else
        SetLastError(ERROR_BAD_DRIVER);
    end;
end;

{$IF CompilerVersion < 21}
initialization
  TProcessMonitorLogger.FDevice := INVALID_HANDLE_VALUE;
finalization
  TProcessMonitorLogger.Close();
{$IFEND}
end.

Usage:

uses
  ProcMonDebugOutput;
begin
  PML.Output('How hard could it be?');
end;

Posted in Delphi, Tips and Tricks | Tagged: , , , , , , , | 10 Comments »

 
Follow

Get every new post delivered to your Inbox.