How can I call another application from my Delphi service? - delphi

Question

I've made a service with Delphi. Every time I call another application in that service the application is not running. What is wrong?
BTW I have used shellexecute, shellopen or calling it with cmd. None of these methods work.
This is my code:
program roro_serv;
uses
SvcMgr,
Unit1 in 'Unit1.pas' {Service1: TService},
ping in 'ping.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TService1, Service1);
Application.Run;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls, DB, MemDS, DBAccess, MyAccess, Menus, forms, IniFiles,
ComCtrls, wininet, Variants, shellapi,
FileCtrl, ExtActns, StdCtrls, ShellCtrls;
type
TService1 = class(TService)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure ServiceExecute(Sender: TService);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceStart(Sender: TService; var Started: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
procedure run_procedure;
procedure log(text_file, atext : string );
procedure loginfo(text : string);
function CheckUrl(url: string): boolean;
procedure execCMD(CommandLine, Work: string);
function DoDownload(FromUrl, ToFile: String): boolean;
end;
var
Service1: TService1;
iTime : integer;
limit_time : integer = 2;
myini : TiniFile;
default_exe_path : string = '';
default_log_path : string = '';
appdir : String = '';
implementation
{$R *.DFM}
uses ping;
function TService1.CheckUrl(url: string): boolean;
var
hSession, hfile, hRequest: hInternet;
dwindex,dwcodelen :dword;
dwcode:array[1..20] of char;
res : pchar;
begin
if pos('http://',lowercase(url))=0 then
url := 'http://'+url;
Result := false;
hSession := InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
if assigned(hsession) then
begin
hfile := InternetOpenUrl(
hsession,
pchar(url),
nil,
0,
INTERNET_FLAG_RELOAD,
0);
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE,
#dwcode, dwcodeLen, dwIndex);
res := pchar(#dwcode);
result:= (res ='200') or (res ='302');
if assigned(hfile) then
InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;
function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TService1.Timer1Timer(Sender: TObject);
begin
iTime:=iTime+1;
if iTime=15 then // (limit_time*60) then
begin
itime:=1;
run_procedure;
end;
// loginfo('Defaultlog : '+default_log_path+'; exe : '+default_exe_path);
end;
procedure TService1.ServiceExecute(Sender: TService);
begin
Timer1.Enabled := True;
while not Terminated do
ServiceThread.ProcessRequests(True);
Timer1.Enabled := False;
end;
procedure TService1.run_procedure;
var
i : integer;
sUrl, sLogFile, sAction, sAct_param : String;
begin
for i:=0 to 20 do
begin
sLogFile:=default_log_path+myini.ReadString('logs', 'log_file'+intTostr(i), '');
if fileexists(slogfile) then
begin
loginfo(slogfile+' tersedia');
sAction:=myini.ReadString('logs', 'action'+intTostr(i), '');
if ((trim(sAction)<>'') and (fileexists(default_exe_path+sAction))) then
begin
// this line is don't work in servcie
ShellExecute(Application.Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
sAct_param:=myini.ReadString('logs', 'action_prm'+intTostr(i), '');
// this line is don't work in servcie
execCMD(sAction+' '+sAct_param, default_exe_path);
loginfo(sAction+' '+sAct_param+' defpath : '+default_exe_path);
// this loginfo works
end;
end else
begin
end;
end;
end;
procedure TService1.log(text_file, atext: string);
var
logFile : TextFile;
begin
AssignFile(LogFile, text_file);
if FileExists(text_file) then
Append(LogFile) else rewrite(LogFile);
WriteLn(logFile, aText);
CloseFile(LogFile);
end;
procedure TService1.loginfo(text: string);
begin
log(ChangeFileExt(application.exename, '.log'), formatdateTime('dd-mm-yyyy hh:nn:ss ', now)+
text);
end;
procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
myini.Free;
end;
procedure TService1.execCMD(CommandLine, Work: string);
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WorkDir: string;
begin
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, #SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
finally
CloseHandle(StdOutPipeRead);
end;
end;
procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
appdir:=ExtractFileDir(Application.ExeName);
myini:=TiniFile.Create(ExtractFileDir(application.ExeName)+'\setting.ini');
limit_time:=myini.ReadInteger('setting', 'limit_time', 0);
default_exe_path:=myini.ReadString('setting', 'default_exe_path','');
if trim(default_exe_path)='' then default_exe_path:=appdir+'\';
default_log_path:=myini.ReadString('setting', 'default_log_path','');
if trim(default_log_path)='' then default_log_path:=appdir+'\logs\';
end;
function TService1.DoDownload(FromUrl, ToFile: String): boolean;
begin
{ with TDownloadURL.Create(self) do
try
URL:=FromUrl;
FileName := ToFile;
ExecuteTarget(nil) ;
finally
Free;
end; }
end;
end.
Please see run_procedure code line;
Put simply: how can I call another application from my service?

Answer 1

ShellExecute/Ex() and CreateProcess() run the specified file/app in the same session as the calling process. A service always runs in session 0.
In XP and earlier, the first user to log in also runs in session 0, so a service can run an interactive process and have it viewable to that interactive user, but only if the service is marked as interactive (the TService.Interactive property is true). If multiple users are logged in, they run in session 1+, and thus cannot see interactive processes run by services.
Windows Vista introduced a new feature called "Session 0 Isolation". Interactive users no longer run in session 0 at all, they always run in session 1+ instead, and session 0 is not interactive at all (the TService.Interactive property no longer has any effect). However, to help with migration of legacy services, if a service runs an interactive process that tries to display a GUI on session 0, Windows prompts the current logged in user, if any, to switch to a separate desktop that temporarily makes the GUI viewable. In Windows 7 onwards, that legacy support is now gone.
In all versions on Windows from 2000 onwards, the correct way to run an interactive process from a service and have it be viewable to an interactive user is to use CreateProcessAsUser() to run the new process in the specified user's session and desktop. There are plenty of detailed examples available on MSDN, StackOverflow, and throughout the Web, so I'm not going to reiterate them here.

Answer 2

Services run in a different session from the interactive user. Services run in session 0. Session 0 processes do not have access to the interactive desktop. Which means that any attempt to show an interactive process in session 0 is doomed to fail. You are attempting to create a Notepad process which is interactive.
There are ways to launch a process on an interactive desktop from a session: Launching an interactive process from Windows Service in Windows Vista and later. As you will understand after reading that article, what you are attempting to do is non-trivial.

Answer 3

This solution is intended to be used from within a service, I thought I'd paste this code here as it was how I got my service to run an application as the currently logged in user.
function WTSQueryUserToken(SessionId: ULONG; var phToken: THandle): BOOL; stdcall; external 'Wtsapi32.dll';
procedure runApp(appName: String);
var
hToken: THandle;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
res: boolean;
begin
GetStartupInfo(StartupInfo);
if WTSQueryUserToken(WtsGetActiveConsoleSessionID, hToken) then
begin
res := CreateProcessAsUser(hToken, PWideChar(appName), nil, nil, nil, False, CREATE_NEW_CONSOLE, nil, nil, StartupInfo, ProcessInfo);
if res then
WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
end;
end;
//Anywhere in your service or app
RunApp ('notepad.exe');