delphi以system运行程序

代码来源于网络 Win7下不可用 Xp下测试无压力

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.

推荐分享