Delphi 从服务运行带有VirtualShellTools的程序时出错

我在Delphi中创建了一个服务。我需要这个服务来运行我的程序。在Windows 7中，我使用以下代码执行程序：

procedure ExecuteProcessAsLoggedOnUser(FileName: string);

implementation

function GetShellProcessName: string;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKeyReadOnly
      ('Software\Microsoft\Windows NT\CurrentVersion\WinLogon');
    Result := Reg.ReadString('Shell');
  finally
    Reg.Free;
  end;
end;

function GetShellProcessPid(const Name: string): Longword;
var
  Snapshot: THandle;
  Process: TProcessEntry32;
  B: Boolean;
begin
  Result := 0;
  Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Snapshot <> INVALID_HANDLE_VALUE then
    try
      FillChar(Process, SizeOf(Process), 0);
      Process.dwSize := SizeOf(Process);
      B := Process32First(Snapshot, Process);
      while B do
      begin
        if CompareText(Process.szExeFile, Name) = 0 then
        begin
          Result := Process.th32ProcessID;
          Break;
        end;
        B := Process32Next(Snapshot, Process);
      end;
    finally
      CloseHandle(Snapshot);
    end;
end;

function GetShellHandle: THandle;
var
  Pid: Longword;
begin
  Pid := GetShellProcessPid(GetShellProcessName);
  Result := OpenProcess(PROCESS_ALL_ACCESS, False, Pid);
end;

procedure ExecuteProcessAsLoggedOnUser(FileName: string);
var
  ph: THandle;
  hToken, nToken: THandle;
  ProcInfo: TProcessInformation;
  StartInfo: TStartupInfo;
begin
  ph := GetShellHandle;
  if ph > 0 then
  begin
    if OpenProcessToken(ph, TOKEN_DUPLICATE or TOKEN_QUERY, hToken) then
    begin
      if DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY or TOKEN_DUPLICATE or
        TOKEN_QUERY, nil, SecurityImpersonation, TokenPrimary, nToken) then
      begin
        if ImpersonateLoggedOnUser(nToken) then
        begin
          // Initialize then STARTUPINFO structure
          FillChar(StartInfo, SizeOf(TStartupInfo), 0);
          StartInfo.cb := SizeOf(TStartupInfo);
          // Specify that the process runs in the interactive desktop
          StartInfo.lpDesktop := PChar('WinSta0\Default');

          // Launch the process in the client's logon session
          CreateProcessAsUser(nToken, nil, PChar(FileName), nil, nil, False,
            CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartInfo,
            ProcInfo);

          // End impersonation of client
          RevertToSelf();
        end;
        CloseHandle(nToken);
      end;
      CloseHandle(hToken);
    end;
  end;
end;

procedure executeprocessaslogedonuser（文件名：string）；
实施
函数GetShellProcessName:string；
变量
注册：树木学；
开始
Reg:=TRegistry.Create（KEY\u READ）；
尝试
Reg.RootKey:=HKEY\U LOCAL\U机器；
Reg.OpenKeyReadOnly
（'Software\Microsoft\windowsnt\CurrentVersion\WinLogon'）；
结果：=Reg.ReadString（'Shell'）；
最后
注册免费；
结束；
结束；
函数GetShellProcessPid（const Name:string）：长单词；
变量
快照：坦德尔；
进程：tprocesentry32；
B：布尔型；
开始
结果：=0；
快照：=CreateToolHelp32Snapshot（TH32CS_SNAPPROCESS，0）；
如果快照句柄值无效，则
尝试
FillChar（进程，SizeOf（进程），0）；
Process.dwSize:=SizeOf（进程）；
B:=Process32First（快照、进程）；
而B是
开始
如果CompareText（Process.szExeFile，Name）=0，则
开始
结果：=Process.th32ProcessID；
打破
结束；
B:=Process32Next（快照、进程）；
结束；
最后
CloseHandle（快照）；
结束；
结束；
函数GetShellHandle:THandle；
变量
Pid：长单词；
开始
Pid:=GetShellProcessPid（GetShellProcessName）；
结果：=OpenProcess（PROCESS\u ALL\u ACCESS，False，Pid）；
结束；
过程ExecuteProcessSlogedOnUser（文件名：字符串）；
变量
ph:THandle；
赫托肯，恩托肯：坦德尔；
ProcInfo:TProcessInformation；
StartInfo:TStartupInfo；
开始
ph:=GetShellHandle；
如果ph>0，则
开始
如果OpenProcessToken（ph，TOKEN\u DUPLICATE或TOKEN\u QUERY，hToken），则
开始
如果重复TokenEx（hToken、TOKEN\u ASSIGN\u PRIMARY或TOKEN\u DUPLICATE或
TOKEN_QUERY，nil，SecurityImpersonation，TokenPrimary，nToken）然后
开始
如果ImpersonalLoggeDonUser（nToken），则
开始
//初始化STARTUPINFO结构
FillChar（StartInfo，SizeOf（TStartupInfo），0）；
StartInfo.cb:=SizeOf（TStartupInfo）；
//指定进程在交互式桌面中运行
StartInfo.lpDesktop:=PChar（'WinSta0\Default'）；
//在客户端的登录会话中启动进程
CreateProcessAsUser（nToken，nil，PChar（文件名），nil，nil，False，
创建新控制台或普通优先级类，nil，nil，StartInfo，
ProcInfo）；
//客户端的结束模拟
restortoself（）；
结束；
闭合手柄（nToken）；
结束；
闭合手柄（hToken）；
结束；
结束；
结束；

---

对于“空”程序，代码可以正常工作。所以我把tVirtualSpolorerTreeView放到我的程序表单上。如果我启动我的服务，那么在调用程序时会出现错误。我猜这个程序不能枚举PIDL或blabla（我对Windowsshell不太了解）。如何强制程序正常运行？

原因可能是您的

WinSta0

：

从Windows Vista开始，服务（以及由服务启动的进程）与桌面交互的方式发生了变化，因为服务不再与控制台上的用户在同一会话中运行

默认情况下，它们无法再与桌面交互

---

关于这个问题，请参阅一些不错的链接。

好吧，我现在很困惑，因为我刚刚尝试在XP中运行我的服务，哦，不，我在VST的单元中也遇到了一个错误（我使用madExcept）。是的，WinSta0绝对不是你的代码所说的交互式桌面！实际上，服务启动GUI进程并非闻所未闻。这是可以做到的。当它失败时，

CreateProcessAsUser（）

实际返回什么错误代码？我怀疑这个问题是否与VST有关。此外，不要搜索用户的shell应用程序（BTW，shell注册表项可以列出多个可执行文件），而应该考虑使用WTS API，例如<代码> WTSGETActudioEndoSeSeCudio（）/<代码>和<代码> WTSkyReSueToEnEn（）/<代码>。在调用

CreateProcessAsUser（）

之前，您还应该调用

CreateEnvironmentBlock（）

，以确保应用程序具有正确的用户特定环境。谢谢雷米，我现在无法触摸我的代码，但我在中找到了您的代码。我试试看。这需要服务吗？安排任务更合适吗？@David，我制作了一个小型安全程序，需要提升、自动启动，并且需要后台任务来监控某些对象。在我看来，我需要创建一个服务和一个GUI。不幸的是，服务无法调用GUI：（服务无法调用GUI，但这仅仅是因为GUI不是一个函数，因此不能被任何东西调用。（请记住，“GUI”可能用词不当。可能没有人登录。或者可能有几个人同时登录。）服务与非服务通信的方式有很多，包括邮件槽、套接字、命名管道、事件和共享内存。但服务无需启动GUI。将其留给用户会话（例如使用启动组）@Rob:我的意思是GUI指的是一个程序。例如，服务发现一些东西并与程序通信，然后程序将执行其余操作。问题是，如果程序没有运行，服务将无法调用该程序。哦，我没有。我只是分析了类似的程序，如果我终止该程序，服务将不会再次启动它。谢谢，