以SYSTEM权限运行程序

program SysTemRun;  
 
uses  
  Windows,  
  tlhelp32,  
  AccCtrl,  
  AclAPI;  
 
 
 
function UpperCase(const S: string): string;  
var  
  Ch: Char;  
  L: Integer;  
  Source, Dest: PChar;  
begin  
  L := Length(S);  
  SetLength(Result, L);  
  Source := Pointer(S);  
  Dest := Pointer(Result);  
  while L <> 0 do 
  begin  
    Ch := Source^;  
    if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);  
    Dest^ := Ch;  
    Inc(Source);  
    Inc(Dest);  
    Dec(L);  
  end;  
end;  
 
function LowerCase(const S: string): string;  
var  
  Ch: Char;  
  L: Integer;  
  Source, Dest: PChar;  
begin  
  L := Length(S);  
  SetLength(Result, L);  
  Source := Pointer(S);  
  Dest := Pointer(Result);  
  while L <> 0 do 
  begin  
    Ch := Source^;  
    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);  
    Dest^ := Ch;  
    Inc(Source);  
    Inc(Dest);  
    Dec(L);  
  end;  
end;  
 
function Trim(const S: string): string;  
var  
  I, L: Integer;  
begin  
  L := Length(S);  
  I := 1;  
  while (I <= L) and (S[I] <= ' ') do Inc(I);  
  if I > L then Result := '' else 
  begin  
    while S[L] <= ' ' do Dec(L);  
    Result := Copy(S, I, L - I + 1);  
  end;  
end;  
 
function findprocess(TheProcName: string): DWORD;  
var  
isOK: Boolean;  
ProcessHandle: Thandle;  
ProcessStruct: TProcessEntry32;  
begin  
ProcessHandle := createtoolhelp32snapshot(Th32cs_snapprocess, 0);  
processStruct.dwSize := sizeof(ProcessStruct);  
isOK := process32first(ProcessHandle, ProcessStruct);  
Result := 0;  
while isOK do 
begin  
    if Trim(UpperCase(TheProcName)) = Trim(UpperCase(ProcessStruct.szExeFile)) then  
    begin  
      Result := ProcessStruct.th32ProcessID;  
      CloseHandle(ProcessHandle);  
      exit;  
    end;  
    isOK := process32next(ProcessHandle, ProcessStruct);  
end;  
CloseHandle(ProcessHandle);  
end;  
 
procedure SetPrivilege;  
var  
TPPrev, TP: TTokenPrivileges;  
TokenHandle: THandle;  
dwRetLen: DWORD;  
lpLuid: TLargeInteger;  
begin  
OpenProcessToken(GetCurrentProcess, TOKEN_ALL_ACCESS, TokenHandle);  
if (LookupPrivilegeValue(nil, 'SeDebugPrivilege', lpLuid)) then  
begin  
    TP.PrivilegeCount := 1;  
    TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;  
    TP.Privileges[0].Luid := lpLuid;  
    AdjustTokenPrivileges(TokenHandle, False, TP, SizeOf(TPPrev), TPPrev, dwRetLen);  
end;  
CloseHandle(TokenHandle);  
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;  
SetPrivilege;  
//选择 WINLOGON 进程  
dwPid := findprocess('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 的长度  
    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;  
 
var  
  FileDir:String;  
begin  
  CreateSystemProcess('NOTEPAD.EXE');
  {FileDir := ParamStr(1);
  if FileDir <> '' then  
  begin  
     CreateSystemProcess(PAnsiChar(FileDir));  
  end;  }
end.