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

编程问答 2022-06-01

问题描述

我试图在 SYstem 级别下执行一个外部程序，并且我应用了 this method（我只将 CreateProcessAsSystem('c:\windows\system32\cmd.exe'); 更改为我想要执行的应用程序的路径）并且它仅当有一个用户登录到 PC 时，才能按预期完美运行。

例如。我有 2 个用户（user1 和 user2）并且两个用户都已登录（先是 user1，然后是 user2）。然后，我在 user2 中运行该程序，而我的外部程序应该会出现在 user2 的桌面上。但是，它出现在user1 的桌面上。我能知道是什么导致了这种情况发生，我该如何解决？

问题重现：

  1. 创建两个用户（user1 和 user2）
  2. 先登录user1，然后登录user2
  3. 在 user2 中运行程序

代码：

测试系统.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 GetToken@R_392_4045@ion(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,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 : TProcess@R_392_4045@ion;
  P : Pointer;
begin
  if not WTSQueryUserToken(WtsGetActiveConsoleSessionID,hUserToken) then exit;

  if not OpenProcesstoken(OpenProcess(PROCESS_ALL_ACCESS,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,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.

TestProcess.dpr

program TestProcess;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,Winapi.Shlobj,Winapi.ShellApi,TestSystem in 'TestSystem.pas' {TestService: TService};

{$region 'Functions to show process''s thread window'}
function EnumWindowsCallback(Handle: HWND; lParam: Integer): BOOL; stdcall;
var
  WID,PID: Integer;
  Text: PWideChar;
  Placement: twindowPlacement;
begin
  WID := 0;
  PID := lParam;
  GetwindowThreadProcessId(Handle,@WID);
  if (PID = WID) and IsWindowVisible(Handle) then begin
    ShowWindow(Handle,SW_MINIMIZE);
    ShowWindow(Handle,SW_SHOWnorMAL);
    var test := SetForegroundWindow(Handle);
    OutputDebugString(PWideChar(BoolToStr(test,true)));
    FlashWindow(Handle,True);
    GetwindowText(Handle,Text,150);
    WriteLn('Window ' + Text + ' showed.');
    Result := False;
  end;
  Result := True;
end;

function ShowProcessWindow(PID: Integer): Boolean;
begin
  Result := EnumWindows(@EnumWindowsCallback,LParaM(PID));
end;
{$endregion}

{$region 'Function to kill process'}
procedure KillProcessWithID(PID: Integer);
begin
  var handle := OpenProcess(PROCESS_TERMINATE,false,PID);
  if handle > 0 then begin
    TerminateProcess(handle,0);
    CloseHandle(handle);
  end;
end;
{$endregion}

{$region 'Function to search for process using process name'}
function processExists(exeFileName: string; out PID: Integer): Boolean;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle := Createtoolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
  Result := False;
  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
    begin
      PID := FProcessEntry32.th32ProcessID;
      Result := True;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;
{$endregion}

var
  ID: Integer;
  Ok: Boolean;
  Input: string;

begin
  try
    repeat
      Write('Enter a process name to check: ');
      ReadLn(Input);
      ID := 0;
      Ok := processExists(Input,ID);

      {$region 'display process @R_392_4045@ion'}
      WriteLn('');
      WriteLn('Process ' + Input + ' exists --> ' + BoolToStr(Ok,True) + ' --> ' + IntToStr(ID));
      WriteLn('');
      {$endregion}

      {$region 'Show process'}
      if IsUserAnAdmin and (ID > 0) then begin
        WriteLn('Attempt to show process''s thread window...');
        ShowProcessWindow(ID);
      end else if not IsUserAnAdmin then
        WriteLn('Require elevated privilege to show process''s thread window.');
      {$endregion}

      {$region 'Kill process'}
      if (ID > 0) and IsUserAnAdmin then begin
        var reply := '';
        repeat
          Write('Kill process ' + Input + ' (' + IntToStr(ID) + ')? ');
          ReadLn(reply);
        until (reply.ToLower = 'y') or (reply.ToLower = 'n');

        if reply.ToLower = 'y' then KillProcessWithID(ID);
      end else if not IsUserAnAdmin then
        WriteLn('Require elevated privilege to kill process.');
      {$endregion}
    until Input = '';
  except
    on E: Exception do
      Writeln(E.ClassName,': ',E.Message);
  end;
end.

主.dpr

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.

解决方法

我遇到了与您相同的问题，问题是由您的 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,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;
delphimultiple-userspascal