如何使用Delphi2007运行未升级的进程
我有一个类似安装程序的应用程序,我必须在Vista上运行升级。但是从那里开始,我不得不开始一个新的过程。任何提示如何与Delphi2007做到这一点?如何使用Delphi2007运行未升级的进程
一种方式来完成,这是使用Windows任务计划程序。
本博客文章是详细和实用
http://developersoven.blogspot.com/2007/02/leveraging-vistas-uac-with-delphi-part.html
的想法是使用你的应用以低权限和COM DLL与提升的特权。然后当你需要提升时,你只需启动COM。完整的MPLed源链接包含在帖子中。
这是一个非常有用的帖子,但请注意,Meelik想要完全相反。 – 2009-02-05 13:39:05
请注意,这是否会有所帮助,但在c#.net中有类似的问题here,但它可能会给你一些线索去看看,或者你可以尝试一个端口到Delphi。
只是一个提示尽量不要在应用程序文件名更新/安装/设置,因为Vista会自动添加安全图标到EXE的。
您可以使用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;
讨论我发现了一个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;
Aaron Margosis的以下文章涵盖了Exa这个主题:FAQ: How do I start a program as the desktop user from an elevated app?
基本的想法是获取shell进程的用户标记,即explorer.exe
,从中创建主标记并最终用该标记启动新进程。
该文章包括一些C++代码,应该很容易转换为Delphi。它还包括下列项目列表概述了办法:
- 启用SeIncreaseQuotaPrivilege在当前令牌
- 获取表示桌面外壳(GetShellWindow)
- 获得进程ID(PID)的HWND与该窗口相关联的过程(GetWindowThreadProcessId)
- 打开该进程(OpenProcess)
- 从该过程获得的访问令牌(OpenProcessToken)
- 使主令牌与令牌(DuplicateTokenEx)
- 开始与主令牌(CreateProcessWithTokenW)
我想添加到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
。
请参阅MSDN上的[示例](http://msdn.microsoft.com/en-us/library/bb250462.aspx#dse_stlip“启动低完整性进程”)。 – 2009-02-06 13:11:57