Get full command line from process - delphi

Question

I have the process ID (PID), how can I get its full command line (path and arguments)?

Answer 1

I recently had to do this; needed to terminate known applications, perform a task, then restart them with the same command line parameters they started with.
Of all the methods that I explored that can achieve getting command line parameters for each running process, WMI proved to be the safest and least painful way.
Add the 2 units pasted below, then call GetProcessList() and loop through the objects in the TObjectList. In your application, ensure you call CoInitialize(nil) on start up, and CoUninitialize() before it's closed. Code tested in Delphi 6.
unit uWmi;
interface
uses
Classes, Contnrs,
Variants, ActiveX, ComObj;
const
WMI_RESULT_OK = 0;
WMI_RESULT_NO_RECORDS = 1;
WMI_RESULT_NULL = 2;
WMI_RESULT_INVALID_PROPERTY = 3;
WMI_RESULT_ERROR_EXEC_QUERY = 4;
WMI_RESULT_UNKNOWN_ERROR = 5;
WMI_RESULT_STRINGS: array [0..5] of string = (
'OK',
'No records',
'Property value is null',
'Invalid property',
'Error executing query',
'Unknown error'
);
type
TWmi = class
private
FService: OleVariant;
function ExecWmiQuery(const AWMIQuery: string; var AItems: OleVariant; var AEnum: IEnumVariant): Boolean;
public
constructor Create;
class function GetWmiObject(const objectName: string): IDispatch;
class function GetWmiSelectQuery(const AWMIClass: string; const ASelectAll: Boolean; const AWMIProperties: TStrings = nil; const AWMIProperty: string = ''): string;
class function GetWmiPropertyValue(const AItem: OleVariant; const AProperty: string; var AValue: string): Integer;
class procedure AddWmiPropertyValueToList(const AValue: string; AResult: Integer; AValues: TStrings); overload;
class procedure AddWmiPropertyValueToList(const AItem: OleVariant; const AProperty: string; AValues: TStrings); overload;
function GetFirstRecordSinglePropertyValue(const AWMIClass, AWMIProperty: string; var AValue: string;
const ASelectAll: Boolean): Integer; overload;
function GetFirstRecordSinglePropertyValue(const AWMIProperty: string; var AValue: string;
const AWMIQuery: string): Integer; overload;
function GetAllRecordsSinglePropertyValues(const AWMIClass, AWMIProperty: string; AValues: TStrings;
const ASelectAll: Boolean): Integer; overload;
function GetAllRecordsSinglePropertyValues(const AWMIProperty: string; AValues: TStrings;
const AWMIQuery: string): Integer; overload;
function GetAllRecordsMultiplePropertiesValues(const AWMIClass: string; AProperties: TStrings;
ARecords: TObjectList; const ASelectAll: Boolean): Integer; overload;
function GetAllRecordsMultiplePropertiesValues(AProperties: TStrings; ARecords: TObjectList;
const AWMIQuery: string): Integer; overload;
function GetAllRecordsMultiplePropertiesValues(const AWMIClass: string; const AProperties: array of string;
ARecords: TObjectList; const ASelectAll: Boolean): Integer; overload;
function GetAllRecordsMultiplePropertiesValues(const AProperties: array of string;
ARecords: TObjectList; const AWMIQuery: string): Integer; overload;
end;
implementation
uses
SysUtils, uStringUtils;
const
wbemFlagForwardOnly = $00000020;
{ TWmi }
function TWmi.ExecWmiQuery(const AWMIQuery: string; var AItems: OleVariant; var AEnum: IEnumVariant): Boolean;
begin
try
AItems := FService.ExecQuery(AWMIQuery, 'WQL', wbemFlagForwardOnly);
AEnum := IUnknown(AItems._NewEnum) as IEnumVariant;
Result := True;
except
Result := False;
end;
end;
constructor TWmi.Create;
{$IFDEF USE_LOCATOR}
const
USER = '';
PASSWORD = '';
COMPUTER = 'localhost';
var
locator: OleVariant;
{$ENDIF}
begin
{$IFDEF USE_LOCATOR}
locator := CreateOleObject('WbemScripting.SWbemLocator');
FService := locator.ConnectServer(COMPUTER, 'root\CIMV2', USER, PASSWORD);
{$ELSE}
FService := GetWmiObject('winmgmts:\\localhost\root\cimv2');
{$ENDIF}
end;
class function TWmi.GetWmiObject(const objectName: string): IDispatch;
var
chEaten: Integer;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
class function TWmi.GetWmiSelectQuery(const AWMIClass: string; const ASelectAll: Boolean;
const AWMIProperties: TStrings = nil; const AWMIProperty: string = ''): string;
var
props: string;
i: Integer;
begin
if ASelectAll then
props := '*'
else
if AWMIProperties = nil then
props := AWMIProperty
else
for i := 0 to AWMIProperties.Count - 1 do
if props = '' then
props := AWMIProperties[i]
else
props := props + ',' + AWMIProperties[i];
Result := Format('SELECT %s FROM %s', [props, AWMIClass]);
end;
class function TWmi.GetWmiPropertyValue(const AItem: OleVariant; const AProperty: string; var AValue: string): Integer;
var
v: OleVariant;
begin
try
v := AItem.Properties_.Item(AProperty).Value;
except
Result := WMI_RESULT_INVALID_PROPERTY;
AValue := '';
Exit;
end;
if VarIsNull(v) then
begin
Result := WMI_RESULT_NULL;
AValue := '';
Exit;
end;
AValue := Trim(v);
Result := WMI_RESULT_OK;
end;
class procedure TWmi.AddWmiPropertyValueToList(const AValue: string; AResult: Integer; AValues: TStrings);
begin
AValues.AddObject(AValue, TObject(AResult));
end;
class procedure TWmi.AddWmiPropertyValueToList(const AItem: OleVariant; const AProperty: string; AValues: TStrings);
var
value: string;
r: Integer;
begin
r := GetWmiPropertyValue(AItem, AProperty, value);
AddWmiPropertyValueToList(value, r, AValues);
end;
function TWmi.GetFirstRecordSinglePropertyValue(const AWMIClass, AWMIProperty: string; var AValue: string;
const ASelectAll: Boolean): Integer;
begin
Result := GetFirstRecordSinglePropertyValue(AWMIProperty, AValue,
GetWmiSelectQuery(AWMIClass, ASelectAll, nil, AWMIProperty));
end;
function TWmi.GetFirstRecordSinglePropertyValue(const AWMIProperty: string; var AValue: string;
const AWMIQuery: string): Integer;
var
items, item: OleVariant;
enum: IEnumVariant;
value: Cardinal;
begin
try
if not ExecWmiQuery(AWMIQuery, items, enum) then
begin
Result := WMI_RESULT_ERROR_EXEC_QUERY;
Exit;
end;
if enum.Next(1, item, value) <> 0 then
Result := WMI_RESULT_NO_RECORDS
else
try
Result := GetWmiPropertyValue(item, AWMIProperty, AValue);
finally
item := Unassigned;
end;
except {on: EOleException do Writeln(e.Source, ' ', e.ErrorCode, ' ', e.Message);}
Result := WMI_RESULT_UNKNOWN_ERROR;
end;
end;
function TWmi.GetAllRecordsSinglePropertyValues(const AWMIClass, AWMIProperty: string; AValues: TStrings;
const ASelectAll: Boolean): Integer;
begin
Result := GetAllRecordsSinglePropertyValues(AWMIProperty, AValues,
GetWmiSelectQuery(AWMIClass, ASelectAll, nil, AWMIProperty));
end;
function TWmi.GetAllRecordsSinglePropertyValues(const AWMIProperty: string; AValues: TStrings; const AWMIQuery: string): Integer;
var
items, item: OleVariant;
enum: IEnumVariant;
value: Cardinal;
begin
try
if not ExecWmiQuery(AWMIQuery, items, enum) then
begin
Result := WMI_RESULT_ERROR_EXEC_QUERY;
Exit;
end;
AValues.Clear;
while enum.Next(1, item, value) = 0 do
try
AddWmiPropertyValueToList(item, AWMIProperty, AValues);
finally
item := Unassigned;
end;
if AValues.Count = 0 then
Result := WMI_RESULT_NO_RECORDS
else
Result := WMI_RESULT_OK;
except {on: EOleException do Writeln(e.Source, ' ', e.ErrorCode, ' ', e.Message);}
Result := WMI_RESULT_UNKNOWN_ERROR;
AValues.Clear;
end;
end;
function TWmi.GetAllRecordsMultiplePropertiesValues(const AWMIClass: string; AProperties: TStrings;
ARecords: TObjectList; const ASelectAll: Boolean): Integer;
begin
Result := GetAllRecordsMultiplePropertiesValues(AProperties, ARecords,
GetWmiSelectQuery(AWMIClass, ASelectAll, AProperties));
end;
function TWmi.GetAllRecordsMultiplePropertiesValues(AProperties: TStrings; ARecords: TObjectList;
const AWMIQuery: string): Integer;
var
items, item: OleVariant;
enum: IEnumVariant;
value: Cardinal;
values: TStrings;
i: Integer;
begin
try
if not ExecWmiQuery(AWMIQuery, items, enum) then
begin
Result := WMI_RESULT_ERROR_EXEC_QUERY;
Exit;
end;
ARecords.Clear;
while enum.Next(1, item, value) = 0 do
try
values := TStringList.Create;
ARecords.Add(values);
for i := 0 to AProperties.Count - 1 do
AddWmiPropertyValueToList(item, AProperties[i], values);
finally
item := Unassigned;
end;
if ARecords.Count = 0 then
Result := WMI_RESULT_NO_RECORDS
else
Result := WMI_RESULT_OK;
except {on: EOleException do Writeln(e.Source, ' ', e.ErrorCode, ' ', e.Message);}
Result := WMI_RESULT_UNKNOWN_ERROR;
ARecords.Clear;
end;
end;
function TWmi.GetAllRecordsMultiplePropertiesValues(const AWMIClass: string; const AProperties: array of string;
ARecords: TObjectList; const ASelectAll: Boolean): Integer;
var
props: TStringList;
begin
props := CreateStringList(AProperties);
try
Result := GetAllRecordsMultiplePropertiesValues(AWMIClass, props, ARecords, ASelectAll);
finally
props.Free;
end;
end;
function TWmi.GetAllRecordsMultiplePropertiesValues(const AProperties: array of string;
ARecords: TObjectList; const AWMIQuery: string): Integer;
var
props: TStrings;
begin
props := CreateStringList(AProperties);
try
Result := GetAllRecordsMultiplePropertiesValues(props, ARecords, AWMIQuery);
finally
props.Free;
end;
end;
{initialization
CoInitialize(nil);
finalization
CoUninitialize;}
end.
unit uWmiProcess;
interface
uses
Contnrs;
type
TProcessInfo = class
public
Name: string;
ProcessId: Cardinal;
ExecutablePath: string;
CommandLine: string;
SessionId: Integer;
CreationDate: string;
end;
function GetProcessList: TObjectList{<TProcessInfo>};
implementation
uses
SysUtils, Classes, uWmi;
function GetProcessList: TObjectList{<TProcessInfo>};
var
wmi: TWmi;
processInfo: TProcessInfo;
records: TObjectList;
values: TStringList;
i: Integer;
function CallWmi(const AProps: array of string): Boolean;
begin
Result := wmi.GetAllRecordsMultiplePropertiesValues('Win32_Process', AProps, records, False) = uWmi.WMI_RESULT_OK;
end;
begin
Result := TObjectList.Create(True);
try
records := TObjectList.Create(True);
try
wmi := TWmi.Create;
try
if not CallWmi(['Name', 'ProcessId', 'ExecutablePath', 'CommandLine', 'SessionId', 'CreationDate']) then
Exit;
for i := 0 to records.Count - 1 do
begin
processInfo := TProcessInfo.Create;
Result.Add(processInfo);
values := TStringList(records[i]);
processInfo.Name := values[0];
processInfo.ProcessId := StrToInt(values[1]);
processInfo.ExecutablePath := values[2];
processInfo.CommandLine := values[3];
processInfo.SessionId := StrToInt(values[4]);
processInfo.CreationDate := values[5];
end;
finally
wmi.Free;
end;
finally
records.Free;
end;
except
//FreeAndNil(Result);
Result.Free;
raise;
end;
end;
end.
unit uStringUtils;
interface
uses
Classes;
procedure SplitString(const ASource: string; const ASeparator: Char; AValues: TStrings); overload;
function SplitString(const ASource: string; const ASeparator: Char): TStringList; overload;
function JoinStrings(const ASeparator: string; AValues: TStrings): string;
function CopyRange(const ASource: string; const AIndexFrom, AIndexTo: Integer): string;
type
TStringsHelper = class //poor man's helper :) ToDo should be other way around, naked routines calling the static class?
public
class procedure SplitString(const ASource: string; const ASeparator: Char; AValues: TStrings); overload;
class function SplitString(const ASource: string; const ASeparator: Char): TStringList; overload;
class function JoinStrings(const ASeparator: string; AValues: TStrings): string;
end;
type
TStringArray = array of string;
procedure FillStringList(const AValues: array of string; AStrings: TStrings);
function CreateStringList(const AValues: array of string): TStringList;
function CreateStringArray(const AStrings: array of string): TStringArray;
implementation
function CopyRange(const ASource: string; const AIndexFrom, AIndexTo: Integer): string;
begin
Result := Copy(ASource, AIndexFrom, AIndexTo - AIndexFrom + 1);
end;
procedure SplitString(const ASource: string; const ASeparator: Char; AValues: TStrings);
var
i, lastDelimPos: Integer;
begin
AValues.Clear;
lastDelimPos := 0;
for i := 1 to Length(ASource) do
if ASource[i] = ASeparator then
begin
if lastDelimPos = 0 then
AValues.Add(CopyRange(ASource, 1, i - 1))
else
AValues.Add(CopyRange(ASource, lastDelimPos + 1, i - 1));
lastDelimPos := i;
end;
if lastDelimPos = 0 then
AValues.Add(ASource)
else
AValues.Add(CopyRange(ASource, lastDelimPos + 1, MaxInt));
end;
function SplitString(const ASource: string; const ASeparator: Char): TStringList;
begin
Result := TStringList.Create;
SplitString(ASource, ASeparator, Result);
end;
function JoinStrings(const ASeparator: string; AValues: TStrings): string;
var
s: string;
i, len: Integer;
p: PChar;
begin
case AValues.Count of
0:
Result := '';
1:
Result := AValues[0];
else
len := (AValues.Count - 1) * Length(ASeparator);
for i := 0 to AValues.Count - 1 do
Inc(len, Length(AValues[i]));
SetLength(Result, len);
p := PChar(Result);
for i := 0 to AValues.Count - 1 do
begin
if i = 0 then
s := AValues[i]
else
s := ASeparator + AValues[i];
Move(PChar(s)^, p^, Length(s));
Inc(p, Length(s));
end;
end;
end;
{ TStringsHelper }
class procedure TStringsHelper.SplitString(const ASource: string;
const ASeparator: Char; AValues: TStrings);
begin
uStringUtils.SplitString(ASource, ASeparator, AValues); //Note the explicit unit reference
end;
class function TStringsHelper.SplitString(const ASource: string;
const ASeparator: Char): TStringList;
begin
Result := uStringUtils.SplitString(ASource, ASeparator); //Note the explicit unit reference
end;
class function TStringsHelper.JoinStrings(const ASeparator: string;
AValues: TStrings): string;
begin
Result := uStringUtils.JoinStrings(ASeparator, AValues); //Note the explicit unit reference
end;
procedure FillStringList(const AValues: array of string; AStrings: TStrings);
var
i: Integer;
begin
AStrings.Clear;
AStrings.Capacity := Length(AValues);
for i := 0 to Length(AValues) - 1 do
AStrings.Add(AValues[i]);
end;
function CreateStringList(const AValues: array of string): TStringList;
begin
Result := TStringList.Create;
FillStringList(AValues, Result);
end;
function CreateStringArray(const AStrings: array of string): TStringArray;
var
i: Integer;
begin
SetLength(Result, Length(AStrings));
for i := 0 to Length(AStrings) - 1 do
Result[i] := AStrings[i];
end;
end.