How to find the name of the parent program that started us?

Question

We want our D7 program to know whether it was executed using the ShellExecute command from one of our applications or directly launched by the user.

Is there a reliable way for a Delphi 7 program to determine the name of the program that started it?

Of course, we could use our parent program with a command line argument or another flag, but we would prefer the above approach.

TIA

Answer 1

The simple answer is no.

A more complex answer: "Not as simple as passing a command line parameter."

:)

, . , . , , CodeProject.

, Windows PID ( ), . -, "", . , , , , ( " calc.exe? ?" ).

, , , , , .

, "" ( - , - - ).

, , .

Answer 2

, . , ShellExecute ( CreateProcess), , .

, ; , .

Answer 3

Torry.net , . , Windows 7, Windows, , Win 2000.

uses Tlhelp32;

function GetProcessInfo(ProcessId: Cardinal; out ParentProcessId: Cardinal; out ExeFileName: string): Boolean;
var
  hSnapShot: THandle;
  ProcInfo: TProcessEntry32;
begin
  hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapShot <> THandle(-1)) then
  try
    ProcInfo.dwSize := SizeOf(ProcInfo);

    if (Process32First(hSnapshot, ProcInfo)) then
      repeat
        if ProcInfo.th32ProcessID = ProcessId then
        begin
          ExeFileName := string(ProcInfo.szExeFile);
          ParentProcessId := ProcInfo.th32ParentProcessID;
          Result := True;
          Exit;
        end;
      until not Process32Next(hSnapShot, ProcInfo);
  finally
    CloseHandle(hSnapShot);
  end;

  Result := False;
end;

procedure Test;
var
  ProcessId, ParentProcessId, Dummy: Cardinal;
  FileName: string;
begin
  ProcessId := GetCurrentProcessId();
  // Get info for current process
  if GetProcessInfo(ProcessId, ParentProcessId, FileName) then
    // Get info for parent process
    if GetProcessInfo(ParentProcessId, Dummy, FileName) then
      // Show it.
      ShowMessage(IntToStr(ParentProcessId) + FileName);
end;

! . , , , , , , .

Answer 4

getpids, NtQueryInformationProcess, , - , , .

Delphi, , :

unit ProcInfo;

interface

uses
  Windows, SysUtils;

function GetParentProcessId(ProcessID: DWORD; out ProcessImageFileName: string): DWORD; overload;

implementation

uses
  PsApi;

var
  hNtDll: THandle;
  NtQueryInformationProcess: function(ProcessHandle: THandle; ProcessInformationClass: DWORD;
    ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG): DWORD; stdcall;

const
  UnicodeStringBufferLength = 1025;

type
  PPEB = Pointer; // PEB from winternl.h not needed here
  PPROCESS_BASIC_INFORMATION = ^PROCESS_BASIC_INFORMATION;
  PROCESS_BASIC_INFORMATION = record
    Reserved1: Pointer; // exit status
    PebBaseAddress: PPEB;
    Reserved2: array[0..1] of Pointer; // affinity mask, base priority
    UniqueProcessId: ULONG_PTR;
    Reserved3: Pointer; // parent process ID
  end;
  PProcessBasicInformation = ^TProcessBasicInformation;
  TProcessBasicInformation = PROCESS_BASIC_INFORMATION;
  PKernelUserTimes = ^TKernelUserTimes;
  TKernelUserTimes = record
    CreateTime: LONGLONG;
    ExitTime: LONGLONG;
    KernelTime: LONGLONG;
    UserTime: LONGLONG;
  end;
  PUNICODE_STRING = ^UNICODE_STRING;
  UNICODE_STRING = record
    Length: USHORT;
    MaximumLength: USHORT;
    PBuffer: PChar;
    Buffer: array[0..UnicodeStringBufferLength - 1] of Char;
  end;
  PUnicodeString = ^TUnicodeString;
  TUnicodeString = UNICODE_STRING;

function GetProcessCreateTime(hProcess: THandle): LONGLONG;
var
  ProcessTimes: TKernelUserTimes;
begin
  Result := 0;
  FillChar(ProcessTimes, SizeOf(ProcessTimes), 0);
  if NtQueryInformationProcess(hProcess, 4, @ProcessTimes, SizeOf(ProcessTimes), nil) <> 0 then
    Exit;
  Result := ProcessTimes.CreateTime;
end;

function GetProcessParentId(hProcess: THandle): DWORD;
var
  ProcessInfo: TProcessBasicInformation;
begin
  Result := 0;
  FillChar(ProcessInfo, SizeOf(ProcessInfo), 0);
  if NtQueryInformationProcess(hProcess, 0, @ProcessInfo, SizeOf(ProcessInfo), nil) <> 0 then
    Exit;
  Result := DWORD(ProcessInfo.Reserved3);
end;

function GetProcessImageFileName(hProcess: THandle): string;
var
  ImageFileName: TUnicodeString;
begin
  Result := '';
  FillChar(ImageFileName, SizeOf(ImageFileName), 0);
  ImageFileName.Length := 0;
  ImageFileName.MaximumLength := UnicodeStringBufferLength * SizeOf(Char);
  ImageFileName.PBuffer := @ImageFileName.Buffer[0];

  if NtQueryInformationProcess(hProcess, 27, @ImageFileName, SizeOf(ImageFileName), nil) <> 0 then
    Exit;
  SetString(Result, ImageFileName.PBuffer, ImageFileName.Length);
end;

function GetParentProcessId(ProcessId: DWORD; out ProcessImageFileName: string): DWORD;
var
  hProcess, hParentProcess: THandle;
  ProcessCreated, ParentCreated: LONGLONG;
begin
  Result := 0;
  ProcessImageFileName := '';

  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);
  if hProcess = 0 then
    RaiseLastOSError;
  try
    Result := GetProcessParentId(hProcess);
    if Result = 0 then
      Exit;
    ProcessCreated := GetProcessCreateTime(hProcess);
  finally
    CloseHandle(hProcess);
  end;

  hParentProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, Result);
  if hParentProcess = 0 then
    RaiseLastOSError;
  try
    ParentCreated := GetProcessCreateTime(hParentProcess);
    if ParentCreated > ProcessCreated then
    begin
      Result := 0;
      Exit;
    end;

    ProcessImageFileName := GetProcessImageFileName(hParentProcess);
  finally
    CloseHandle(hParentProcess);
  end;
end;

initialization
  hNtDll := GetModuleHandle('ntdll.dll');
  if hNtDll <> 0 then
    NTQueryInformationProcess := GetProcAddress(hNtDll, 'NtQueryInformationProcess');

end.

IDE, :

parent ID: 5140, : "\ Device\HarddiskVolume1\Program Files\Embarcadero\RAD \8.0\Bin\bds.exe"

"" , . "C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe".