How can I call another application from my Delphi service?

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.