I have code which is used both in services and within VCL Form applications (win32 application). How can I determine if the underlying application is running as a NT Service or as an application?
Thanks.
BEGIN OF EDIT
Since this still seems to be getting some attention I decided to update the answer with missing info and newer windows patches. In any case you should not copy / paste the code. The code is just a showcase on how the things should be done.
END OF EDIT:
You can check if the parent process is SCM (service control manager). If you are running as service this is always the case and never the case if running as standard application. Also I think that SCM has always the same PID.
You can check it like this:
type
TAppType = (atUnknown, atDesktop, atService);
var
AppType: TAppType;
function InternalIsService: Boolean;
var
PL: TProcessList;
MyProcessId: DWORD;
MyProcess: PPROCESSENTRY32;
ParentProcess: PPROCESSENTRY32;
GrandParentProcess: PPROCESSENTRY32;
begin
Result := False;
PL := TProcessList.Create;
try
PL.CreateSnapshot;
MyProcessId := GetCurrentProcessId;
MyProcess := PL.FindProcess(MyProcessId);
if MyProcess <> nil then
begin
ParentProcess := PL.FindProcess(MyProcess^.th32ParentProcessID);
if ParentProcess <> nil then
begin
GrandParentProcess := PL.FindProcess(ParentProcess^.th32ParentProcessID);
if GrandParentProcess <> nil then
begin
Result := SameText(string(ParentProcess^.szExeFile), 'services.exe') and
(SameText(string(GrandParentProcess^.szExeFile), 'winlogon.exe') or
SameText(string(GrandParentProcess^.szExeFile), 'wininit.exe'));
end;
end;
end;
finally
PL.Free;
end;
end;
function IsService: Boolean;
begin
if AppType = atUnknown then
begin
try
if InternalIsService then
AppType := atService
else
AppType := atDesktop;
except
AppType := atService;
end;
end;
Result := AppType = atService;
end;
initialization
AppType := atUnknown;
The TProcessList is implemented like this (again THashTable is not included but any hash table should be fine):
type
TProcessEntryList = class(TList)
private
function Get(Index: Integer): PPROCESSENTRY32;
procedure Put(Index: Integer; const Value: PPROCESSENTRY32);
public
property Items[Index: Integer]: PPROCESSENTRY32 read Get write Put; default;
function Add(const Entry: TProcessEntry32): Integer; reintroduce;
procedure Clear; override;
end;
TProcessList = class
private
ProcessIdHashTable: THashTable;
ProcessEntryList: TProcessEntryList;
public
constructor Create; reintroduce;
destructor Destroy; override;
procedure CreateSnapshot;
function FindProcess(const ProcessId: DWORD): PPROCESSENTRY32;
end;
implementation
{ TProcessEntryList }
procedure TProcessEntryList.Clear;
var
i: Integer;
begin
i := 0;
while i < Count do
begin
FreeMem(Items[i]);
Inc(i);
end;
inherited;
end;
procedure TProcessEntryList.Put(Index: Integer; const Value: PPROCESSENTRY32);
var
Item: Pointer;
begin
Item := inherited Get(Index);
CopyMemory(Item, Value, SizeOf(tagPROCESSENTRY32));
end;
function TProcessEntryList.Get(Index: Integer): PPROCESSENTRY32;
begin
Result := PPROCESSENTRY32(inherited Get(Index));
end;
function TProcessEntryList.Add(const Entry: TProcessEntry32): Integer;
var
EntryCopy: PPROCESSENTRY32;
begin
GetMem(EntryCopy, SizeOf(tagPROCESSENTRY32));
CopyMemory(EntryCopy, @Entry, SizeOf(tagPROCESSENTRY32));
Result := inherited Add(EntryCopy);
end;
{ TProcessList }
constructor TProcessList.Create;
begin
inherited;
ProcessEntryList := TProcessEntryList.Create;
ProcessIdHashTable := THashTable.Create;
end;
destructor TProcessList.Destroy;
begin
FreeAndNil(ProcessIdHashTable);
FreeAndNil(ProcessEntryList);
inherited;
end;
function TProcessList.FindProcess(const ProcessId: DWORD): PPROCESSENTRY32;
var
ItemIndex: Integer;
begin
Result := nil;
if not ProcessIdHashTable.ContainsKey(IntToStr(ProcessId)) then
Exit;
ItemIndex := Integer(ProcessIdHashTable.Item[IntToStr(ProcessId)]);
Result := ProcessEntryList.Items[ItemIndex];
end;
procedure TProcessList.CreateSnapshot;
var
SnapShot: THandle;
ProcessEntry: TProcessEntry32;
ItemIndex: Integer;
begin
SnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if SnapShot <> 0 then
try
ProcessEntry.dwSize := SizeOf(ProcessEntry);
if Process32First(SnapShot, ProcessEntry) then
repeat
ItemIndex := ProcessEntryList.Add(ProcessEntry);
ProcessIdHashTable.Add(IntToStr(ProcessEntry.th32ProcessID), TObject(ItemIndex));
until not Process32Next(SnapShot, ProcessEntry);
finally
CloseHandle(SnapShot);
end;
end;
The application object (Forms.application) mainform will be nil if it is not a forms based application.
uses
Forms, ... ;
function IsFormBased : boolean;
begin
Result := Assigned(Forms.Application.MainForm);
end;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With