Subscribe by Email
SourceForge profileThe 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;
Advertisements
