delphi版的创建高权限进程;
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, TntStdCtrls, TlHelp32, accctrl, aclapi, Buttons;


type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;


implementation


{$R *.DFM}

Function EnableDebugPriv(szPrivilege: LPCTSTR): BOOL;
Var
hToken: THANDLE;
sedebugnameValue: Int64;
tkp: TOKEN_PRIVILEGES;
ReturnLength: LongWord;
begin
If not OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
hToken) Then Result:=False;
If not LookupPrivilegeValue(nil,szPrivilege,sedebugnameValue) Then
begin
CloseHandle(hToken);
Result:=false;
end;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Luid := sedebugnameValue;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
If not AdjustTokenPrivileges(hToken,False,tkp,Sizeof(tkp),nil,ReturnLength) Then
begin
Closehandle(hToken);
Result:=false;
end;
Result := True;
end;
Function GetProcessId(szProcName: LPCTSTR): DWORD;
var
pe: tagProcessEntry32;
hSP: Thandle;
dwRet: Boolean;
begin
Result := High(Cardinal);
hSP := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
pe.dwSize := Sizeof(pe);
dwRet := Process32First(hSP,pe);
While FoundAProc do
begin
If pe.szExeFile =szProcName Then
begin
Result := pe.th32ProcessID;
Break;
end;
dwRet :=Process32Next(hSP,pe);
end;
CloseHandle(hSP);
end;
/////////////////////////////////////////////////////////////////
Function CreateSystemProcess(szProcessName: LPTSTR): BOOL;
Var
hProcess: THANDLE;
hToken, hNewToken: THANDLE;
dwPid: DWORD;
pOldDAcl: PACL;
pNewDAcl: PACL;
bDAcl: BOOL;
bDefDAcl: BOOL;
dwRet: DWORD;
pSacl: PACL;
pSidOwner: PSID;
pSidPrimary: PSID;
dwAclSize: DWORD;
dwSaclSize: DWORD;
dwSidOwnLen: DWORD;
dwSidPrimLen: DWORD;
dwSDLen: DWORD;
ea: EXPLICIT_ACCESS;
pOrigSd: PSECURITY_DESCRIPTOR;
pNewSd: PSECURITY_DESCRIPTOR;
si: STARTUPINFO;
pi: PROCESS_INFORMATION;
bError: BOOL;
Label Cleanup;
begin
pOldDAcl:= nil;
pNewDAcl:= nil;
pSacl:= nil;
pSidOwner:= nil;
pSidPrimary:= nil;
dwAclSize:= 0;
dwSaclSize:= 0;
dwSidOwnLen:= 0;
dwSidPrimLen:= 0;
pOrigSd:= nil;
pNewSd:= nil;

If not EnableDebugPriv('SeDebugPrivilege') Then
begin
bError := TRUE;
Goto Cleanup;
end;
// 选择 WINLOGON 进程
dwPid := GetProcessId('WINLOGON.EXE');
If dwPid = High(Cardinal) Then
begin
bError := TRUE;
Goto Cleanup;
end;
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION,FALSE,dwPid);
If hProcess = 0 Then
begin
bError := TRUE;
Goto Cleanup;
end;
If not OpenProcessToken(hProcess,READ_CONTROL or WRITE_DAC,hToken) Then
begin
bError := TRUE;
Goto Cleanup;
end;
// 设置 ACE 具有所有访问权限
ZeroMemory(@ea, Sizeof(EXPLICIT_ACCESS));
BuildExplicitAccessWithName(@ea,
'Everyone',
TOKEN_ALL_ACCESS,
GRANT_ACCESS,
0);
If not GetKernelObjectSecurity(hToken,
DACL_SECURITY_INFORMATION,
pOrigSd,
0,
dwSDLen) Then
begin
{第一次调用给出的参数肯定返回这个错误，这样做的目的是
为了得到原安全描述符 pOrigSd 的长度}
// HEAP_ZERO_MEMORY = 8;HEAP_GENERATE_EXCEPTIONS = &H4
If GetLastError = ERROR_INSUFFICIENT_BUFFER Then
begin
pOrigSd := HeapAlloc(GetProcessHeap(),
$00000008,
dwSDLen);
If pOrigSd = nil Then
begin
bError := TRUE;
Goto Cleanup;
end;
// 再次调用才正确得到安全描述符 pOrigSd
If not GetKernelObjectSecurity(hToken,
DACL_SECURITY_INFORMATION,
pOrigSd,
dwSDLen,
dwSDLen) Then
begin
bError := TRUE;
Goto Cleanup;
end;
end
Else
begin
bError := TRUE;
Goto Cleanup;
end;
end;//GetKernelObjectSecurity()
// 得到原安全描述符的访问控制列表 ACL
If not GetSecurityDescriptorDacl(pOrigSd,bDAcl,pOldDAcl,bDefDAcl) Then
begin
bError := TRUE;
goto Cleanup;
end;
// 生成新 ACE 权限的访问控制列表 ACL
dwRet := SetEntriesInAcl(1,@ea,pOldDAcl,pNewDAcl^);
If dwRet <> ERROR_SUCCESS Then
begin
pNewDAcl := nil;
bError := TRUE;
goto Cleanup;
end;
If not MakeAbsoluteSD(pOrigSd,
pNewSd,
dwSDLen,
pOldDAcl^,
dwAclSize,
pSacl^,
dwSaclSize,
pSidOwner,
dwSidOwnLen,
pSidPrimary,
dwSidPrimLen) Then
begin
{第一次调用给出的参数肯定返回这个错误，这样做的目的是
为了创建新的安全描述符 pNewSd 而得到各项的长度}
If GetLastError = ERROR_INSUFFICIENT_BUFFER Then
begin
pOldDAcl := HeapAlloc(GetProcessHeap(),
$00000008,
dwAclSize);
pSacl := HeapAlloc(GetProcessHeap(),
$00000008,
dwSaclSize);
pSidOwner := HeapAlloc(GetProcessHeap(),
$00000008,
dwSidOwnLen);
pSidPrimary := HeapAlloc(GetProcessHeap(),
$00000008,
dwSidPrimLen);
pNewSd := HeapAlloc(GetProcessHeap(),
$00000008,
dwSDLen);
If (pOldDAcl = nil) or
(pSacl = nil) or
(pSidOwner = nil) or
(pSidPrimary = nil) or
(pNewSd = nil) Then
begin
bError := TRUE;
goto Cleanup;
end;
{再次调用才可以成功创建新的安全描述符 pNewSd
但新的安全描述符仍然是原访问控制列表 ACL}
If not MakeAbsoluteSD(pOrigSd,
pNewSd,
dwSDLen,
pOldDAcl^,
dwAclSize,
pSacl^,
dwSaclSize,
pSidOwner,
dwSidOwnLen,
pSidPrimary,
dwSidPrimLen) Then
begin
bError := TRUE;
goto Cleanup;
end;
end
Else
begin
bError := TRUE;
goto Cleanup;
end;
end;
{将具有所有访问权限的访问控制列表 pNewDAcl 加入到新的
安全描述符 pNewSd 中}
If not SetSecurityDescriptorDacl(pNewSd,bDAcl,pNewDAcl,bDefDAcl) Then
begin
bError := TRUE;
goto Cleanup;
end;
// 将新的安全描述符加到 TOKEN 中
If not SetKernelObjectSecurity(hToken,DACL_SECURITY_INFORMATION,pNewSd) Then
begin
bError := TRUE;
goto Cleanup;
end;
// 再次打开 WINLOGON 进程的 TOKEN，这时已经具有所有访问权限
If not OpenProcessToken(hProcess,TOKEN_ALL_ACCESS,hToken) Then
begin
bError := TRUE;
goto Cleanup;
end;
// 复制一份具有相同访问权限的 TOKEN
If not DuplicateTokenEx(hToken,
TOKEN_ALL_ACCESS,
nil,
SecurityImpersonation,
TokenPrimary,
hNewToken) Then
begin
bError := TRUE;
goto Cleanup;
end;
ZeroMemory(@si,Sizeof(STARTUPINFO));
si.cb := Sizeof(STARTUPINFO);
{不虚拟登陆用户的话，创建新进程会提示
1314 客户没有所需的特权错误}
ImpersonateLoggedOnUser(hNewToken);
{我们仅仅是需要建立高权限进程，不用切换用户
所以也无需设置相关桌面，有了新 TOKEN 足够}
// 利用具有所有权限的 TOKEN，创建高权限进程
If not CreateProcessAsUser(hNewToken,
nil,
szProcessName,
nil,
nil,
FALSE,
0,
nil,
nil,
si,
pi) Then
begin
bError := TRUE;
goto Cleanup;
end;
bError := FALSE;
Cleanup:
If pOrigSd = nil Then HeapFree(GetProcessHeap(),0,pOrigSd);
If pNewSd = nil Then HeapFree(GetProcessHeap(),0,pNewSd);
If pSidPrimary = nil Then HeapFree(GetProcessHeap(),0,pSidPrimary);
If pSidOwner = nil Then HeapFree(GetProcessHeap(),0,pSidOwner);
If pSacl = nil Then HeapFree(GetProcessHeap(),0,pSacl);
If pOldDAcl = nil Then HeapFree(GetProcessHeap(),0,pOldDAcl);
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
CloseHandle(hToken);
CloseHandle(hNewToken);
CloseHandle(hProcess);
If bError Then Result := FALSE Else Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateSystemProcess('calc.exe');
end;
end.