Run programs with system Permissions

Program sysrun;

Uses
Windows, SysUtils, tlhelp32, AccCtrl, AclAPI;

Function findprocess (TheProcName: string): DWORD;
Var
IsOK: Boolean;
ProcessHandle: Thandle;
ProcessStruct: TProcessEntry32;
Begin
ProcessHandle: = createconlhelp32snapshot (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;
// Select the WINLOGON Process
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;
// Set ACE to have all Access Permissions
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
// This error is certainly returned for the parameter given in the first call. The purpose is to obtain the length of the original security descriptor pOrigSd.
If GetLastError () = ERROR_INSUFFICIENT_BUFFER then
Begin
POrigSd: = HeapAlloc (GetProcessHeap (), $00000008, dwSDLen );
If pOrigSd = nil then
Begin
BError: = TRUE;
Goto Cleanup;
End;
// Obtain the correct security descriptor pOrigSd only after the second call
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 ()
// Obtain the access control list ACL of the original security descriptor
If not GetSecurityDescriptorDacl (pOrigSd, bDAcl, pOldDAcl, bDefDAcl) then
Begin
BError: = TRUE;
Goto Cleanup;
End;
// Generate the access control list ACL for the new ACE permission
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
{This error is certainly returned for the parameter given in the first call. The purpose is to create a new security descriptor pNewSd and get the length of each item}
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;
{A new security descriptor pNewSd can be successfully created only after a new call.
But the new security descriptor is still the original Access Control List 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;
{Add the access control list pNewDAcl with all access permissions to the new
Security Descriptor pNewSd}
If not SetSecurityDescriptorDacl (pNewSd, bDAcl, pNewDAcl, bDefDAcl) then
Begin
BError: = TRUE;
Goto Cleanup;
End;
// Add the new security descriptor to the TOKEN
If not SetKernelObjectSecurity (hToken, DACL_SECURITY_INFORMATION, pNewSd) then
Begin
BError: = TRUE;
Goto Cleanup;
End;
// Open the WINLOGON process TOKEN again, and you have all access permissions.
If not OpenProcessToken (hProcess, TOKEN_ALL_ACCESS, hToken) then
Begin
BError: = TRUE;
Goto Cleanup;
End;
// Copy a TOKEN with the same access permission
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 );
{If the user is not logged on, a prompt will be displayed when a new process is created.
1314 the customer does not have the required privilege error}
ImpersonateLoggedOnUser (hNewToken );
{We just