德爾福的服務應用程序不要在桌面上打開一個exe文件？

Question

我在Delphi中使用了Service Application。這是我在ServiceExecute方法

procedure TMDPSERVICE.ServiceExecute(Sender: TService); 
const 
    SecBetweenRuns = 10; 
var 
    Count: Integer; 
begin 
    while not Terminated do // loop around until we should stop 
    begin 
    Inc(Count); 
    if Count >= SecBetweenRuns then 
    begin 
     if not DoFindTask('c:\weblod.exe') then 
     WinExec(PAnsiChar('c:\weblod.exe'), SW_NORMAL); 
    end; 
    Sleep(10); 
    end; 
end; 

代碼，我可以看到在任務管理器weblod.exe文件，但它沒有顯示在桌面上？

Answer 1

服務在隔離的會話中運行，會話0交互式桌面始終處於不同的會話中。閱讀有關會話0隔離的信息以瞭解更多

如果要啓動交互式桌面上的過程中，你需要的是這樣的：create process in user session from service

Answer 2

首先，你是濫用TService.OnExecute事件。具體而言，您永遠不會撥打ServiceThread.ProcessRequests()，以便您的服務可以響應SCM請求。最起碼，你必須添加到您的循環：

procedure TMDPSERVICE.ServiceExecute(Sender: TService); 
const 
    SecBetweenRuns = 10; 
var 
    Count: Integer; 
begin 
    while not Terminated do // loop around until we should stop 
    begin 
    Inc(Count); 
    if Count >= SecBetweenRuns then 
    begin 
     if not DoFindTask('c:\weblod.exe') then 
     WinExec(PAnsiChar('c:\weblod.exe'), SW_NORMAL); 
    end; 
    Sleep(10); 
    ServiceThread.ProcessRequests(False); // <-- add this 
    end; 
end; 

一個更好的（和首選）選項是不是在所有使用OnExecute事件。當沒有分配OnExecute處理程序時，TService會自動處理SCM請求。您應該使用TService.OnStart事件來啓動一個工作線程，並使用TService.OnStop/TService.OnShutdown事件終止該線程：

type 
    TMyTaskThread = class(TThread) 
    protected 
    procedure Execute; override; 
    end; 

procedure TMyTaskThread.Execute; 
const 
    SecBetweenRuns = 10; 
var 
    Count: Integer; 
begin 
    while not Terminated do // loop around until we should stop 
    begin 
    Inc(Count); 
    if Count >= SecBetweenRuns then 
    begin 
     if not DoFindTask('c:\weblod.exe') then 
     WinExec(PAnsiChar('c:\weblod.exe'), SW_NORMAL); 
    end; 
    Sleep(10); 
    end; 
end; 

type 
    TMDPSERVICE = class(TService) 
    procedure ServiceStart(Sender: TService; var Started: Boolean); 
    procedure ServiceStop(Sender: TService; var Stopped: Boolean); 
    procedure ServiceShutdown(Sender: TService); 
    private 
    FTask: TMyTaskThread; 
    end; 

procedure TMDPSERVICE.ServiceStart(Sender: TService; var Started: Boolean); 
begin 
    FTask := TMyTaskThread.Create(False); 
    Started := True; 
end; 

procedure TMDPSERVICE.ServiceStop(Sender: TService; var Stopped: Boolean); 
begin 
    ServiceShutdown(Sender); 
    Stopped := True; 
end; 

procedure TMDPSERVICE.ServiceShutdown(Sender: TService); 
begin 
    if Assigned(FTask) then 
    begin 
    FTask.Terminate; 
    while WaitForSingleObject(FTask.Handle, WaitHint-100) = WAIT_TIMEOUT do 
     ReportStatus; 
    FreeAndNil(FTask); 
    end; 
end; 

現在，隨着中說，WinExec()已自Windows棄用95被首次引入。根本不要使用WinExec()，尤其是從服務中。您需要改用CreateProcessAsUser()。這不僅允許您指定要在哪個桌面上運行進程，還允許您指定進程在哪個用戶會話中運行。由於會話0隔離，這在Windows Vista及更高版本中尤其重要，在用戶不會再運行在同一個會話中（這也是爲什麼TService.Interactive屬性不再受支持）。如果您未指定用戶會話，則該進程將與該服務在同一會話中運行，並且與該服務運行的用戶相同（通常爲SYSTEM）。登錄的用戶永遠不會看到該進程。

嘗試更多的東西是這樣的：

function WTSGetActiveConsoleSessionId: DWORD; stdcall; external 'Wtsapi32.dll'; 
function WTSQueryUserToken(SessionId: ULONG; var phToken: THandle): BOOL; stdcall; external 'Wtsapi32.dll'; 

function CreateEnvironmentBlock(var lpEnvironment: Pointer; hToken: THandle; bInherit: BOOL): BOOL; stdcall; external 'Userenv.dll'; 
function DestroyEnvironmentBlock(lpEnvironment: Pointer): BOOL; stdcall; external 'Userenv.dll'; 

function RunTaskOnUserDesktop(CmdLine: string): Boolean; 
var 
    hToken: THandle; 
    env: Pointer; 
    si: STARTUPINFO; 
    pi: PROCESS_INFORMATION; 
begin 
    Result := False; 
    // WTSGetActiveConsoleSessionId() returns the ID of the user session that is 
    // logged in to the physical console (keyboard/mouse/screen). If remote users 
    // can login to your machine, and you want to run your process in a remote 
    // user's session, use WTSEnumerateSessions() instead to find the ID of the 
    // desired logged-in user session... 
    // 
    if not WTSQueryUserToken(WTSGetActiveConsoleSessionId(), hToken) then 
    Exit; 
    try 
    if not CreateEnvironmentBlock(env, hToken, False) then 
     Exit; 
    try 
     ZeroMemory(@si, SizeOf(si)); 
     si.cb := SizeOf(si); 
     si.lpDesktop := 'Winsta0\Default'; 
     si.dwFlags := STARTF_USESHOWWINDOW; 
     si.wShowWindow := SW_SHOWNORMAL; 
     Result := CreateProcessAsUser(hToken, nil, PChar(CmdLine), nil, nil, False, CREATE_UNICODE_ENVIRONMENT, env, nil, si, pi); 
     if Result then 
     begin 
     CloseHandle(pi.hThread); 
     CloseHandle(pi.hProcess); 
     end; 
    finally 
     DestroyEnvironmentBlock(env); 
    end; 
    finally 
    CloseHandle(hToken); 
    end; 
end; 

... 

const 
    SecBetweenRuns = 10; 
var 
    Count: Integer; 
begin 
    while not Terminated do // loop around until we should stop 
    begin 
    Inc(Count); 
    if Count >= SecBetweenRuns then 
    begin 
     if not DoFindTask('c:\weblod.exe') then 
     RunTaskOnUserDesktop('c:\weblod.exe'); 
    end; 
    Sleep(10); 
    end; 
end;