如何使用Delphi2007运行未升级的进程

Question

我有一个类似安装程序的应用程序，我必须在Vista上运行升级。但是从那里开始，我不得不开始一个新的过程。任何提示如何与Delphi2007做到这一点？

Answer 1

一种方式来完成，这是使用Windows任务计划程序。

这与代码示例中 http://delphi.newswhat.com/geoxml/forumhistorythread?groupname=borland.public.delphi.rtl.win32&messageid=473447a5$1@newsgroups.borland.com

Answer 2

本博客文章是详细和实用

http://developersoven.blogspot.com/2007/02/leveraging-vistas-uac-with-delphi-part.html

的想法是使用你的应用以低权限和COM DLL与提升的特权。然后当你需要提升时，你只需启动COM。完整的MPLed源链接包含在帖子中。

Answer 3

请注意，这是否会有所帮助，但在c＃.net中有类似的问题here，但它可能会给你一些线索去看看，或者你可以尝试一个端口到Delphi。

只是一个提示尽量不要在应用程序文件名更新/安装/设置，因为Vista会自动添加安全图标到EXE的。

Answer 4

您可以使用CreateProcessWithLogonW() API调用：

function CreateProcessWithLogonW(lpUsername: PWideChar; lpDomain: PWideChar; 
    lpPassword: PWideChar; dwLogonFlags: DWORD; lpApplicationName: PWideChar; 
    lpCommandLine: PWideChar; dwCreationFlags: DWORD; lpEnvironment: Pointer; 
    lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo; 
    var lpProcessInformation: TProcessInformation): BOOL; stdcall; 
    external 'advapi32.dll' name 'CreateProcessWithLogonW'; 



procedure RunAs(AUsername, APassword, ADomain, AApplication: string); 
const 
    LOGON_WITH_PROFILE = $00000001; 
var 
    si: TStartupInfo; 
    pi: TProcessInformation; 
begin 
    ZeroMemory(@si, SizeOf(si)); 
    si.cb := SizeOf(si); 
    si.dwFlags := STARTF_USESHOWWINDOW; 
    si.wShowWindow := SW_NORMAL; 
    ZeroMemory(@pi, SizeOf(pi)); 

    if not CreateProcessWithLogonW(PWideChar(WideString(AUsername)), 
    PWideChar(WideString(ADomain)), PWideChar(WideString(APassword)), 
    LOGON_WITH_PROFILE, nil, PWideChar(WideString(AApplication)), 
    0, nil, nil, si, pi) 
    then 
    RaiseLastOSError; 

    CloseHandle(pi.hThread); 
    CloseHandle(pi.hProcess); 
end; 

Answer 5

讨论我发现了一个excellent example for C++和将它改编为Delphi：

unit MediumIL; 

interface 

uses 
    Winapi.Windows; 

function CreateProcessMediumIL(lpApplicationName: PWChar; lpCommandLine: PWChar; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandle: BOOL; dwCreationFlags: DWORD; lpEnvironment: LPVOID; lpCurrentDirectory: PWChar; const lpStartupInfo: TStartupInfoW; var lpProcessInformation: TProcessInformation): DWORD; 

implementation 

type 
    TOKEN_MANDATORY_LABEL = record 
    Label_: SID_AND_ATTRIBUTES; 
    end; 

    PTOKEN_MANDATORY_LABEL = ^TOKEN_MANDATORY_LABEL; 

    TTokenMandatoryLabel = TOKEN_MANDATORY_LABEL; 
    PTokenMandatoryLabel = ^TTokenMandatoryLabel; 

    TCreateProcessWithTokenW = function (hToken: THandle; dwLogonFlags: DWORD; lpApplicationName: LPCWSTR; lpCommandLine: LPWSTR; dwCreationFlags: DWORD; lpEnvironment: LPVOID; lpCurrentDirectory: LPCWSTR; const lpStartupInfo: TStartupInfoW; out lpProcessInfo: TProcessInformation): BOOL; stdcall; 

const 
    SECURITY_MANDATORY_UNTRUSTED_RID = $00000000; 
    SECURITY_MANDATORY_LOW_RID = $00001000; 
    SECURITY_MANDATORY_MEDIUM_RID = $00002000; 
    SECURITY_MANDATORY_HIGH_RID = $00003000; 
    SECURITY_MANDATORY_SYSTEM_RID = $00004000; 
    SECURITY_MANDATORY_PROTECTED_PROCESS_RID = $00005000; 

function GetShellWindow: HWND; stdcall; external 'user32.dll' name 'GetShellWindow'; 

// writes Integration Level of the process with the given ID into dwProcessIL 
// returns Win32 API error or 0 if succeeded 
function GetProcessIL(dwProcessID: DWORD; var dwProcessIL: DWORD): DWORD; 
label 
    _CleanUp; 
var 
    hProcess: THandle; 
    hToken: THandle; 
    dwSize: DWORD; 
    pbCount: PByte; 
    pdwProcIL: PDWORD; 
    pTIL: PTokenMandatoryLabel; 
    dwError: DWORD; 
begin 
    dwProcessIL := 0; 

    pTIL := nil; 

    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, dwProcessID); 
    if (hProcess = 0) then 
    goto _CleanUp; 

    if (not OpenProcessToken(hProcess, TOKEN_QUERY, hToken)) then 
    goto _CleanUp; 

    if (not GetTokenInformation(hToken, TokenIntegrityLevel, nil, 0, dwSize) and (GetLastError() <> ERROR_INSUFFICIENT_BUFFER)) then 
    goto _CleanUp; 

    pTIL := HeapAlloc(GetProcessHeap(), 0, dwSize); 
    if (pTIL = nil) then 
    goto _CleanUp; 

    if (not GetTokenInformation(hToken, TokenIntegrityLevel, pTIL, dwSize, dwSize)) then 
    goto _CleanUp; 

    pbCount := PByte(GetSidSubAuthorityCount(pTIL^.Label_.Sid)); 
    if (pbCount = nil) then 
    goto _CleanUp; 

    pdwProcIL := GetSidSubAuthority(pTIL^.Label_.Sid, pbCount^ - 1); 
    if (pdwProcIL = nil) then 
    goto _CleanUp; 

    dwProcessIL := pdwProcIL^; 
    SetLastError(ERROR_SUCCESS); 

    _CleanUp: 
    dwError := GetLastError(); 
    if (pTIL <> nil) then 
    HeapFree(GetProcessHeap(), 0, pTIL); 
    if (hToken <> 0) then 
    CloseHandle(hToken); 
    if (hProcess <> 0) then 
    CloseHandle(hProcess); 
    Result := dwError; 
end; 

// Creates a new process lpApplicationName with the integration level of the Explorer process (MEDIUM IL) 
// If you need this function in a service you must replace FindWindow() with another API to find Explorer process 
// The parent process of the new process will be svchost.exe if this EXE was run "As Administrator" 
// returns Win32 API error or 0 if succeeded 
function CreateProcessMediumIL(lpApplicationName: PWChar; lpCommandLine: PWChar; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandle: BOOL; dwCreationFlags: DWORD; lpEnvironment: LPVOID; lpCurrentDirectory: PWChar; const lpStartupInfo: TStartupInfoW; var lpProcessInformation: TProcessInformation): DWORD; 
label 
    _CleanUp; 
var 
    hProcess: THandle; 
    hToken: THandle; 
    hToken2: THandle; 
    bUseToken: BOOL; 
    dwCurIL: DWORD; 
    dwErr: DWORD; 
    f_CreateProcessWithTokenW: TCreateProcessWithTokenW; 
    hProgman: HWND; 
    dwExplorerPID: DWORD; 
    dwError: DWORD; 
begin 
    bUseToken := False; 

    // Detect Windows Vista, 2008, Windows 7 and higher 
    if (GetProcAddress(GetModuleHandleA('Kernel32'), 'GetProductInfo') <> nil) then 
    begin 
    dwErr := GetProcessIL(GetCurrentProcessId(), dwCurIL); 
    if (dwErr <> 0) then 
    begin 
     Result := dwErr; 
     Exit; 
    end; 
     if (dwCurIL > SECURITY_MANDATORY_MEDIUM_RID) then 
     bUseToken := True; 
    end; 

    // Create the process normally (before Windows Vista or if current process runs with a medium IL) 
    if (not bUseToken) then 
    begin 
    if (not CreateProcessW(lpApplicationName, lpCommandLine, lpProcessAttributes, lpThreadAttributes, bInheritHandle, dwCreationFlags, lpEnvironment, lpCurrentDirectory, lpStartupInfo, lpProcessInformation)) then 
    begin 
     Result := GetLastError(); 
     Exit; 
    end; 

    CloseHandle(lpProcessInformation.hThread); 
    CloseHandle(lpProcessInformation.hProcess); 
    Result := ERROR_SUCCESS; 
    Exit; 
    end; 

    f_CreateProcessWithTokenW := GetProcAddress(GetModuleHandleA('Advapi32'), 'CreateProcessWithTokenW'); 

    if (not Assigned(f_CreateProcessWithTokenW)) then // This will never happen on Vista! 
    begin 
    Result := ERROR_INVALID_FUNCTION; 
    Exit; 
    end; 

    hProgman := GetShellWindow(); 

    dwExplorerPID := 0; 
    GetWindowThreadProcessId(hProgman, dwExplorerPID); 

    // ATTENTION: 
    // If UAC is turned OFF all processes run with SECURITY_MANDATORY_HIGH_RID, also Explorer! 
    // But this does not matter because to start the new process without UAC no elevation is required. 
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, dwExplorerPID); 
    if (hProcess = 0) then 
    goto _CleanUp; 

    if (not OpenProcessToken(hProcess, TOKEN_DUPLICATE, hToken)) then 
    goto _CleanUp; 

    if (not DuplicateTokenEx(hToken, TOKEN_ALL_ACCESS, nil, SecurityImpersonation, TokenPrimary, hToken2)) then 
    goto _CleanUp; 

    if (not f_CreateProcessWithTokenW(hToken2, 0, lpApplicationName, lpCommandLine, dwCreationFlags, lpEnvironment, lpCurrentDirectory, lpStartupInfo, lpProcessInformation)) then 
    goto _CleanUp; 

    SetLastError(ERROR_SUCCESS); 

    _CleanUp: 
    dwError := GetLastError(); 
    if (hToken <> 0) then 
    CloseHandle(hToken); 
    if (hToken2 <> 0) then 
    CloseHandle(hToken2); 
    if (hProcess <> 0) then 
    CloseHandle(hProcess); 
    CloseHandle(lpProcessInformation.hThread); 
    CloseHandle(lpProcessInformation.hProcess); 
    Result := dwError; 
end; 

end. 

要在项目中使用，只需使用单位MediumIL：

uses MediumIL; 

… 

procedure TForm1.FormCreate(Sender: TObject); 
var 
    StartupInfo: TStartupInfo; 
    ProcessInfo: TProcessInformation; 
begin 
    ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); 
    ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo)); 
    CreateProcessMediumIL('C:\Windows\notepad.exe', nil, nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo); 
end; 

Answer 6

Aaron Margosis的以下文章涵盖了Exa这个主题：FAQ: How do I start a program as the desktop user from an elevated app?

基本的想法是获取shell进程的用户标记，即explorer.exe，从中创建主标记并最终用该标记启动新进程。

该文章包括一些C++代码，应该很容易转换为Delphi。它还包括下列项目列表概述了办法：

1. 启用SeIncreaseQuotaPrivilege在当前令牌
2. 获取表示桌面外壳（GetShellWindow）
3. 获得进程ID（PID）的HWND与该窗口相关联的过程（GetWindowThreadProcessId）
4. 打开该进程（OpenProcess）
5. 从该过程获得的访问令牌（OpenProcessToken）
6. 使主令牌与令牌（DuplicateTokenEx）
7. 开始与主令牌（CreateProcessWithTokenW）

Answer 7

我想添加到Elçins answer上述新工艺：

如果代码行：

if (not DuplicateTokenEx(hToken, TOKEN_ALL_ACCESS, nil, SecurityImpersonation, TokenPrimary, hToken2)) then 
goto _CleanUp; 

返回错误5 (Access Denied)，则TOKEN_ALL_ACCESS需要是OR用TOKEN_ADJUST_SESSIONID（0x100）编辑。

在Delphi 2010上，将LPVOID更改为POINTER。