开发者

Error when running program with VirtualShellTools from a service

I create a service in Delphi. I need this service to run my program. In Windows 7, I use this code to execute a program :

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;

The code works fine for an "empty" program. So I drop TVirtualExpolorerTreeview onto the form of my program. if I start my service then there will be an error 开发者_如何学编程when the program is being called. I guess the program can't enumerate PIDL or blabla (I don't know much about Windows Shell). How do I force the program so it can run normally?


Your WinSta0 might be the cause:

Starting with Windows Vista, the way that services (and processes started by services) can interact with the desktop changed, as services no longer run in the same session as the user at the console.

By default, they cannot interact with the desktop any more.

See this thread for some nice links on this matter.

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜