JEDI Windows API » Service

Service and application in single EXE? Update

Christian Wimmer — Sat, 10 May 2008 19:50:14 +0000

Creating a binary file that consists of a service and a normal application can be done very simple without using the service manager. Just check for SYSTEM account. It is very unlikely that your app is run as SYSTEM (only RunAsSys does ).

uses …, JwsclToken;
begin
if JwIsSystem then
begin
try
Application.Initialize;
Application.CreateForm(TMyService, MyService);
Application.Run;
end
else
begin
end;
end;

Update

Mark Robinson suggested (in a comment) to check for a “service.exe” parent process. Since I did not find a solution within seconds, I decided to show how it works. Quite in handy came a CodeProject article about finding a parent process. The code is also available through download. Use it on your own risk.

function GetParentProcess(out ProcessEntry32 : TProcessEntry32W; const ProcessID : DWORD = 0) : DWORD; overload;

function InternalGetParentProcess(
const Condition : Boolean;
out ProcessEntry32 : TProcessEntry32W; const ProcessID : DWORD = 0) : DWORD;
var
hSnap : THandle;
ProcEntry : TProcessEntry32W;
currentID : DWORD;
Continue : Boolean;

begin
hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
result := INVALID_HANDLE_VALUE;

ZeroMemory(@ProcessEntry32, sizeof(ProcessEntry32));

try
ProcEntry.dwSize := sizeof(ProcEntry);
Continue := Process32FirstW(hSnap, ProcEntry);

if (ProcessID = DWORD(-1)) or (ProcessID = 0) then
CurrentID := GetCurrentProcessId
else
CurrentID := ProcessID;

result := INVALID_HANDLE_VALUE;

while (continue) do
begin
if CurrentID = ProcEntry.th32ProcessID then
begin
result := ProcEntry.th32ParentProcessID;

if not Condition then
begin
InternalGetParentProcess(true, ProcessEntry32, result);
end
else
ProcessEntry32 := ProcEntry;
end;

continue := Process32NextW(hSnap,ProcEntry) and (result = INVALID_HANDLE_VALUE);
end;
finally
CloseHandle(hSnap);
end;
end;

begin
result := InternalGetParentProcess(false, ProcessEntry32, ProcessID);
end;

function GetParentProcess(const ProcessID : DWORD = 0) : DWORD; overload;
var ProcessEntry32 : TProcessEntry32W;
begin
result := GetParentProcess(ProcessEntry32, ProcessID);
end;

function GetParentProcess(out ExeName : WideString; const ProcessID : DWORD = 0) : DWORD; overload;
var ProcessEntry32 : TProcessEntry32W;
begin
result := GetParentProcess(ProcessEntry32, ProcessID);
if result <> INVALID_HANDLE_VALUE then
ExeName := ProcessEntry32.szExeFile
else
ExeName := ”;
end;

var P : DWORD;
Name : WideString;
begin
P :=GetParentProcess(Name);
writeln(P,‘ ‘,Name);
readln;
end.

There are three versions of GetParentProcess, so you can get more information than usual necessary.
The reason why the first version has an internal function is that we need to iterate the process list twice to get the parent’s process name.

Finally all you have to do is to check for its name “services.exe”.

if CompareText(Name,‘services.exe’) then

However there can be a bad coincidence and another process who started your app is named like that. In this case we should just check for the full path.

function RetrieveModuleFileName(const PID : DWORD) : WideString;
var
FileName : Array[0..MAX_PATH] of Widechar;
hP : THandle;
begin
hP := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, PID);
if hP = 0 then
RaiseLastOSError;

try
if GetModuleFileNameExW(hP,0,FileName, sizeof(FileName)) = 0 then
RaiseLastOSError;
result := FileName;
finally
CloseHandle(hP);
end;
end;

Now we can be sure that it is the correct process.

function GetSystem32Path : WideString;
var Path : Array[0..MAX_PATH] of Widechar;
begin
Result := ”;
if SUCCEEDED(SHGetFolderPathW(0,CSIDL_SYSTEM,0,SHGFP_TYPE_DEFAULT, @Path)) then
result := IncludeTrailingBackslash(Path); //Oopps, may convert unicode to ansicode
end;

var PID : DWORD;
begin
PID := GetParentProcess(Name);

Path := RetrieveModuleFileName(P);
SysPath := GetSystem32Path+‘services.exe’;
if CompareText(SysPath, Path) = 0 then
//OK
else
//not a service
end.

We are not at the end. I should mention that your service application can also be in a service pool hosted by the parent process “svchost.exe”. In such a case of course, we have to check for “svchost.exe” instead of “services.exe”

How to (un-)install and start a service object

Christian Wimmer — Sat, 05 Apr 2008 11:29:43 +0000

Unfortunately Borland didn’t implement a public register and start function into the class TServiceApplication. So we have to do it ourselves.
First we publish the protected RegisterServices function to allow (un-)install our service(s) programmatically.

TServiceApplicationEx = class(TServiceApplication)
public
procedure RegisterServices(Install, Silent: Boolean);
end;

{ TServiceApplicationEx }
procedure TServiceApplicationEx.RegisterServices(Install, Silent: Boolean);
begin
inherited;
end;

Of course we need a tool function that starts our service

uses JwaWindows;procedure StartTheService(Service : TService);
var
hSCM: SC_HANDLE;
hSvc: SC_HANDLE;
args: array of PChar;
i : Integer;
begin
hSCM := OpenSCManager(nil, SERVICES_ACTIVE_DATABASEW, SC_MANAGER_CONNECT);
if hSCM = 0 then
RaiseLastOSError;

try
hSvc := OpenService(hSCM, PChar(Service.Name), SERVICE_START);
if hSvc = 0 then
RaiseLastOSError; try
SetLength(args, ParamCount);

for i := 0 to ParamCount-1 do
begin
GetMem(args[i], Length(ParamStr(i+1))+2);
StringCchCopy(args[i], Length(ParamStr(i+1))+2, PChar(ParamStr(i+1)));
end;

try
if not StartServiceA(hSvc, Length(args), @args[0]) then
RaiseLastOSError;
finally
for i := 0 to ParamCount-1 do
begin
FreeMem(args[i]);
end;
end;
finally
CloseServiceHandle(hSvc);
end;
finally
CloseServiceHandle(hScm);
end;
end;

Finally we can adjust the main application to install, uninstall or run the service.

program xy;
uses SvcMgr, …;
begin
SvcMgr.Application.Free;
SvcMgr.Application := TServiceApplicationEx.Create(nil);
SvcMgr.Application.Initialize;
SvcMgr.Application.CreateForm(TMyService, MyService);
if then
SvcMgr.Application.RegisterServices(true, true)
else
if then
SvcMgr.Application.RegisterServices(false, true)
else
if then
StartService(MyService)
and exit here
else
SvcMgr.Application.Run;
end;

How to get the user’s token from a service?

Christian Wimmer — Mon, 31 Mar 2008 18:27:28 +0000

This simple code excerpt can only be run under SYSTEM account (say in a service). It retrieves the token from the logged on user – especially the user at the physical console. Or in other words the user data of the person that sits in front of the computer. The main code which does the task above can be seen here.

UserToken := TJwSecurityToken.CreateWTSQueryUserToken(WTS_CURRENT_SESSION);

CreateWTSQueryUserToken is only applicable in Windows XP or newer. Use CreateWTSQueryUserTokenEx if you need Windows 2000 support.
WTS_CURRENT_SESSION (-1) defines the console session to be retrieved. Any existing session ID (starting from zero (0) ) can be used instead. If a problems occurs (e.g. session does not exist) you get an exception (see documentation)

uses
JwaWindows,
JwsclToken,
JwsclSid,
JwsclStrings,
SysUtils;

…
var
UserToken : TJwSecurityToken;
ConsoleUser : TJwSecurityId;
UserSidString,
UserName : TJwString;
begin
//erst ab Windows XP
UserToken := TJwSecurityToken.CreateWTSQueryUserToken(WTS_CURRENT_SESSION);
try
ConsoleUser := UserToken.TokenUser;
try
UserSidString := ConsoleUser.StringSID;
UserName := ConsoleUser.GetAccountName(”);
//Writeln(UserSidString);
//Writeln(UserName);
finally
FreeAndNil(ConsoleUser);
end;
//User personifizieren
UserToken.ImpersonateLoggedOnUser;

***

UserToken.RevertToSelf;

finally
FreeAndNil(UserToken);
end;
end;

***) Place functions and do stuff here that needs to be run under the user’s context. Functions like SHGetSpecialFolder use the impersonated token to get the (correct) user folder. Additionally all security checks are made with the user’s token. This comes very handy because a service has (almost) always access to everything (files, reg keys, …) which means a security hole.

[UPDATE]
Fixed some minor mistakes.