Question

我在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;

该代码适用于“空”程序。所以我将TVirtualExpolorerTreeview放到我的程序表单上。如果我启动我的服务，那么在调用程序时会出现错误。我想程序不能枚举PIDL或blabla（我对Windows Shell不太了解）。如何强制程序以使其正常运行？

Answer 1

您的WinSta0可能是原因：

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

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

有关此问题的一些不错的链接，请参阅this thread。

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

1 个答案: