Delphi 运行在不同用户桌面上的外部程序

我试图在

系统

级别下执行一个外部程序，并应用了该程序（我只将

CreateProcessAsSystem（'c:\windows\system32\cmd.exe'）；

更改为我要执行的应用程序的路径），并且只有当有一个用户登录到电脑时，该程序才能正常工作

例如，我有两个用户（

user1

和

user2

），两个用户都已登录（

user1

，然后是

user2

）。然后，我在

user2

中运行程序，我的外部程序应该出现在

user2

的桌面上。但是，它会出现在

user1

的桌面上。我能知道是什么原因导致这种情况发生，以及如何解决这种情况吗

问题再现：

创建两个用户（

user1

和

user2

）

先登录到

user1

，然后再登录到

user2

在

user2

代码：

TestSystem.pas

unit TestSystem;

interface

uses
  Winapi.WinSvc,
  Vcl.SvcMgr,
  Winapi.Windows,
  System.SysUtils,
  Winapi.TlHelp32,
  System.Classes;

type
  TTestService = class(TService)
    procedure ServiceExecute(Sender: TService);
  private
    lpApplicationName,
    lpCommandLine,
    lpCurrentDirectory: PWideChar;
  public
    function GetServiceController: TServiceController; override;
  end;

procedure CreateProcessAsSystem(const lpApplicationName: PWideChar;
                              const lpCommandLine:PWideChar = nil;
                              const lpCurrentDirectory: PWideChar  = nil);
var
  TestService: TTestService;

implementation

{$R *.dfm}

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


type
  TServiceApplicationEx = class(TServiceApplication)
  end;
  TServiceApplicationHelper = class helper for TServiceApplication
  public
    procedure ServicesRegister(Install, Silent: Boolean);
  end;

function IsUserAnAdmin: BOOL; stdcall; external 'shell32.dll' name 'IsUserAnAdmin';

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

function DestroyEnvironmentBlock(pEnvironment: Pointer): BOOL; stdcall; external 'Userenv.dll';


function _GetIntegrityLevel() : DWORD;
type
  PTokenMandatoryLabel = ^TTokenMandatoryLabel;
  TTokenMandatoryLabel = packed record
    Label_ : TSidAndAttributes;
  end;
var
  hToken : THandle;
  cbSize: DWORD;
  pTIL : PTokenMandatoryLabel;
  dwTokenUserLength: DWORD;
begin
  Result := 0;
  dwTokenUserLength := MAXCHAR;
  if OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hToken) then begin
    pTIL := Pointer(LocalAlloc(0, dwTokenUserLength));
    if pTIL = nil then Exit;
    cbSize := SizeOf(TTokenMandatoryLabel);
    if GetTokenInformation(hToken, TokenIntegrityLevel, pTIL, dwTokenUserLength, cbSize) then
      if IsValidSid( (pTIL.Label_).Sid ) then
        Result := GetSidSubAuthority((pTIL.Label_).Sid, GetSidSubAuthorityCount((pTIL.Label_).Sid )^ - 1)^;
    if hToken <> INVALID_HANDLE_VALUE then
      CloseHandle(hToken);
    LocalFree(Cardinal(pTIL));
  end;
end;

function IsUserAnSystem(): Boolean;
const
  SECURITY_MANDATORY_SYSTEM_RID = $00004000;
begin
  Result := (_GetIntegrityLevel = SECURITY_MANDATORY_SYSTEM_RID);
end;

function StartTheService(Service:TService): Boolean;
var
  SCM: SC_HANDLE;
  ServiceHandle: SC_HANDLE;
begin
  Result:= False;
  SCM:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if (SCM <> 0) then begin
    try
      ServiceHandle:= OpenService(SCM, PChar(Service.Name), SERVICE_ALL_ACCESS);
      if (ServiceHandle <> 0) then begin
        Result := StartService(ServiceHandle, 0, pChar(nil^));
        CloseServiceHandle(ServiceHandle);
      end;
    finally
      CloseServiceHandle(SCM);
    end;
  end;
end;

procedure SetServiceName(Service: TService);
begin
  if Assigned(Service) then begin
    Service.DisplayName := 'Run as system service created ' + DateTimeToStr(Now);
    Service.Name        := 'RunAsSystem' + FormatDateTime('ddmmyyyyhhnnss', Now);
  end;
end;

procedure CreateProcessAsSystem(const lpApplicationName: PWideChar;
                              const lpCommandLine:PWideChar = nil;
                              const lpCurrentDirectory: PWideChar  = nil);
begin
  if not ( IsUserAnAdmin ) then begin
    SetLastError(ERROR_ACCESS_DENIED);
    Exit();
  end;

  if not ( FileExists(lpApplicationName) ) then begin
    SetLastError(ERROR_FILE_NOT_FOUND);
    Exit();
  end;

  if ( IsUserAnSystem ) then begin
    Application.Initialize;
    Application.CreateForm(TTestService, TestService);
    TestService.lpApplicationName  := lpApplicationName;
    TestService.lpCommandLine      := lpCommandLine;
    TestService.lpCurrentDirectory := lpCurrentDirectory;
    SetServiceName(TestService);
    Application.Run;
  end else begin
    Application.Free;
    Application := TServiceApplicationEx.Create(nil);
    Application.Initialize;
    Application.CreateForm(TTestService, TestService);
    SetServiceName(TestService);
    Application.ServicesRegister(True, True);
    try
      StartTheService(TestService);
    finally
      Application.ServicesRegister(False, True);
    end;
  end;
end;

procedure TServiceApplicationHelper.ServicesRegister(Install, Silent: Boolean);
begin
  RegisterServices(Install, Silent);
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  TestService.Controller(CtrlCode);
end;

function TTestService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

function ProcessIDFromAppname32( szExeFileName: string ): DWORD;
var
  Snapshot: THandle;
  ProcessEntry: TProcessEntry32;
begin
  Result := 0;
  szExeFileName := UpperCase( szExeFileName );
  Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Snapshot <> 0 then
    try
      ProcessEntry.dwSize := Sizeof( ProcessEntry );
      if Process32First( Snapshot, ProcessEntry ) then
        repeat
          if Pos(szExeFileName, UpperCase(ExtractFilename(StrPas(ProcessEntry.szExeFile)))) > 0 then begin
            Result:= ProcessEntry.th32ProcessID;
            break;
          end;
        until not Process32Next( Snapshot, ProcessEntry );
    finally
      CloseHandle( Snapshot );
    end;
end;

function TerminateProcessByID(ProcessID: Cardinal): Boolean;
var
  hProcess : THandle;
begin
  Result := False;
  hProcess := OpenProcess(PROCESS_TERMINATE,False,ProcessID);
  if hProcess > 0 then
    try
      Result := Win32Check(TerminateProcess(hProcess,0));
    finally
      CloseHandle(hProcess);
    end;
end;

procedure TTestService.ServiceExecute(Sender: TService);
var
  hToken, hUserToken: THandle;
  StartupInfo : TStartupInfoW;
  ProcessInfo : TProcessInformation;
  P : Pointer;
begin
  if not WTSQueryUserToken(WtsGetActiveConsoleSessionID, hUserToken) then exit;

  if not OpenProcessToken(OpenProcess(PROCESS_ALL_ACCESS, False,
                             ProcessIDFromAppname32('winlogon.exe')),
                             MAXIMUM_ALLOWED,
                             hToken) then exit;

  if CreateEnvironmentBlock(P, hUserToken, True) then begin
    ZeroMemory(@StartupInfo, sizeof(StartupInfo));
    StartupInfo.lpDesktop := ('winsta0\default');
    StartupInfo.wShowWindow := SW_SHOWNORMAL;
    if CreateProcessAsUser(hToken, lpApplicationName, lpCommandLine, nil, nil, False,
                CREATE_UNICODE_ENVIRONMENT, P, lpCurrentDirectory, StartupInfo, ProcessInfo) then begin

    end;
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    DestroyEnvironmentBlock(P);
  end;

  CloseHandle(hToken);
  CloseHandle(hUserToken);

  TerminateProcessByID(GetCurrentProcessId);
end;

end.

---

我遇到了与您相同的问题，该问题是由您的

ProcessIDFromAppname32（'winlogon.exe'）

引起的，因为它一直在检索第一个登录用户会话ID的进程ID。您可以尝试添加此代码段来比较并获取当前登录用户会话ID的进程ID

function GetActiveSessionUserName: PWideChar;
var
  Sessions, Session: PWTS_SESSION_INFO;
  NumSessions, I, NumBytes: DWORD;
  UserName: LPTSTR;
begin
  Result := '';
  if not WTSEnumerateSessions(WTS_CURRENT_SERVER_HANDLE, 0, 1, Sessions,
  NumSessions) then
    RaiseLastOSError;
  try
    if NumSessions > 0 then begin
      Session := Sessions;
      for I := 0 to NumSessions - 1 do begin
        if Session.State = WTSActive then
          if WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE,
          Session.SessionId, WTSUserName, UserName, NumBytes) then
            try
              Result := UserName;
            finally
              WTSFreeMemory(UserName);
            end;
        Inc(Session);
      end;
    end;
  finally
    WTSFreeMemory(Sessions);
  end;
end;

---

也许你应该使用CreateProcessAsUser？@Para我实际使用的代码是

CreateProcessAsUser

你读过并理解这个问题的答案了吗？@J。。。是的，我在代码中应用了这些。这个问题与这个问题非常相似：。两个症状完全相同的独立问题。微软最近有什么问题吗？

program Main;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, System.IOUtils, TestSystem, Vcl.Forms;

var
  path: string;

begin
  path := TPath.Combine(TPath.GetDirectoryName(Application.ExeName), 'TestProcess.exe');
  CreateProcessAsSystem(PWideChar(path));
end.

function GetActiveSessionUserName: PWideChar;
var
  Sessions, Session: PWTS_SESSION_INFO;
  NumSessions, I, NumBytes: DWORD;
  UserName: LPTSTR;
begin
  Result := '';
  if not WTSEnumerateSessions(WTS_CURRENT_SERVER_HANDLE, 0, 1, Sessions,
  NumSessions) then
    RaiseLastOSError;
  try
    if NumSessions > 0 then begin
      Session := Sessions;
      for I := 0 to NumSessions - 1 do begin
        if Session.State = WTSActive then
          if WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE,
          Session.SessionId, WTSUserName, UserName, NumBytes) then
            try
              Result := UserName;
            finally
              WTSFreeMemory(UserName);
            end;
        Inc(Session);
      end;
    end;
  finally
    WTSFreeMemory(Sessions);
  end;
end;