1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:

// uses TlHelp32;
procedure TForm1.Button1Click(Sender: TObject);
var 
  PE_Exe    : TProcessEntry32;
  PE_Parent : TProcessEntry32;
  HProcList : THandle;
  ExeName   : string;
  HExe      : THandle;
begin
  ExeName := ExtractFileName(Application.ExeName); 
  HExe := GetCurrentProcessID;
  PE_Exe.dwSize := SizeOf(TProcessEntry32);
  PE_Parent.dwSize := SizeOf(TProcessEntry32);

  // Schnapschuss der aktuellen Prozess-Liste
  HProcList := CreateToolHelp32SnapShot(TH32CS_SnapAll, 0);

  // eigenen Prozess finden
  Process32First(HProcList, PE_Exe);
  repeat
  until (PE_Exe.th32ProcessID = HExe)
    or (not Process32Next(HProcList, PE_Exe));

  // Prozess suchen, der den eigenen Prozess gestartet hat
  Process32First(HProcList, PE_Parent);
  repeat
  until (PE_Parent.th32ProcessID = PE_Exe.th32ParentProcessID)
    or (not Process32Next(HProcList, PE_Parent));

  // Parent-Prozess existiert noch und trägt einen anderen Namen als die Exe
  if (UpperCase(PE_Parent.szExeFile) <> UpperCase(ExeName)) then
    ShowMessage('Programm wurde von ' + PE_Parent.szExeFile + ' gestartet.')
  else
  // Entweder Parent-Prozess nicht mehr verfügbar
  // (dann wird der Name der eigenen Exe zurück gegeben)
    if (PE_Exe.th32ProcessID = PE_Parent.th32ProcessID) then
      ShowMessage('Aufrufender Prozess nicht mehr feststellbar.')
    else
  // oder Parent-Prozess existiert noch, hat aber den gleichen Namen
  // (z. B. Parent-Name = Project1 und Exe-Name = Project1).
      ShowMessage('Programm wurde von ' + PE_Parent.szExeFile + ' gestartet.');

  CloseHandle(HProcList);
end;