如何從我的Delphi服務調用另一個應用程序？

Question

我用Delphi做了一個服務。每次我在該服務中調用另一個應用程序時，應用程序都沒有運行。哪裏不對？

順便說一句我用shellexecute，shellopen或者用cmd調用它。這些方法都不起作用。

這是我的代碼：

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. 

請參閱run_procedure行代碼;

簡單地說：我怎麼能從我的服務中調用另一個應用程序？

Answer 1

ShellExecute/Ex()和CreateProcess()在與調用進程相同的會話中運行指定的文件/應用程序。服務始終運行在會話0中。

在XP和更早版本中，第一個登錄用戶也運行在會話0中，因此服務可以運行交互式進程並讓該交互式用戶可見，但前提是服務被標記爲交互式（TService.Interactive屬性爲真）。如果有多個用戶登錄，他們運行在會話1+中，因此看不到由服務運行的交互式進程。

Windows Vista引入了一項名爲"Session 0 Isolation"的新功能。交互式用戶不再運行在會話0中，而是始終運行在會話1+中，而會話0根本不交互（TService.Interactive屬性不再有任何效果）。但是，爲了幫助遷移舊服務，如果服務運行嘗試在會話0上顯示GUI的交互式進程，則Windows會提示當前登錄的用戶（如果有）切換到單獨的桌面，以便臨時使GUI可見。在Windows 7之後，這種傳統支持現在消失了。

在從2000開始的Windows上的所有版本中，從服務運行交互式進程並使其可供交互式用戶查看的正確方法是使用在指定用戶的會話和桌面中運行新進程。在MSDN，StackOverflow和整個Web上都有很多詳細的示例，所以我不打算在這裏重申它們。

Answer 2

服務在與交互式用戶不同的會話中運行。服務在會話0中運行。會話0進程無權訪問交互式桌面。這意味着任何嘗試在會話0中顯示交互式進程都註定會失敗。您正試圖創建一個交互式的記事本進程。

可以通過會話在交互式桌面上啓動進程：Launching an interactive process from Windows Service in Windows Vista and later。正如你在閱讀那篇文章後會明白的那樣，你試圖做的事情並不重要。