小强工作室

核心代码:
仅支持2000,XP,2003系统

Public Function CreateSystemProcess(ByVal szProcessName As String) As Boolean
    Dim hProcess As Long, dwPid As Long, hToken As Long, hNewToken As Long, pOrigSd As SECURITY_DESCRIPTOR, pNewSd As SECURITY_DESCRIPTOR, dwSDLen As Long, bDAcl As Long, pOldDAcl As ACL, bDefDAcl As Long
    Dim dwRet As Long, pNewDAcl As ACL, pSacl As ACL, dwSidOwnLen As Long, dwSidPrimLen As Long, si As STARTUPINFO, pi As PROCESS_INFORMATION, bError As Boolean
    Dim ea As EXPLICIT_ACCESS, hOrigSd As Long, hOldDAcl As Long, hNewDAcl As Long, dwAclSize As Long, dwSaclSize As Long
    Dim hSacl As Long, hSidOwner As Long, hSidPrimary As Long, hNewSd As Long, lngErr As Long
    Dim hea As Long, hToken1 As Long, pSidOwner As SID, pSidPrimary As SID, ct As SECURITY_DESCRIPTOR
    Dim hSacl1 As Long, hSidOwner1 As Long, hSidPrimary1 As Long
    '提高进程权限为Debug权限
    If Not EnablePrivilege Then
        bError = True
        GoTo Cleanup
    End If
    '得到winlogon的进程ID
    dwPid = GetSystemProcessID
    If dwPid = 0 Then
        bError = True
        GoTo Cleanup
    End If
    '得到句柄
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, dwPid)
    If hProcess = 0 Then
        bError = True
        GoTo Cleanup
    End If
    '得到hToken
    If OpenProcessToken(hProcess, READ_CONTROL Or WRITE_DAC, hToken) = 0 Then
        bError = True
        GoTo Cleanup
    End If
    '设置 ACE 具有所有访问权限
    BuildExplicitAccessWithName ea, "Everyone", TOKEN_ALL_ACCESS, GRANT_ACCESS, 0
    Debug.Print ea.grfAccessMode
    '第一次调用肯定错误,目的是为了得到dwSDLen的值
    If GetKernelObjectSecurity(ByVal hToken, DACL_SECURITY_INFORMATION, ByVal hOrigSd, ByVal 0, dwSDLen) = 0 Then
        lngErr = GetLastError()
        Debug.Print "GetLastError: " & lngErr
        Debug.Print "dwSDLen值为: " & dwSDLen
'        If lngErr = ERROR_INSUFFICIENT_BUFFER Then
            hOrigSd = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwSDLen)
            '再次调用取得正确得到安全描述符hOrigSd
            If GetKernelObjectSecurity(ByVal hToken, DACL_SECURITY_INFORMATION, ByVal hOrigSd, ByVal dwSDLen, dwSDLen) = 0 Then
                bError = True
                GoTo Cleanup
            End If
'        Else
'            bError = True
'            GoTo Cleanup
'        End If
    Else
        bError = True
        GoTo Cleanup
    End If
    '得到原安全描述符的访问控制列表 ACL
    If GetSecurityDescriptorDacl(ByVal hOrigSd, bDAcl, hOldDAcl, bDefDAcl) = 0 Then
        bError = True
        GoTo Cleanup
    End If

    '生成新 ACE 权限的访问控制列表 ACL
    dwRet = SetEntriesInAcl(ByVal 1, ea, hOldDAcl, hNewDAcl)
    If dwRet <> ERROR_SUCCESS Then
        hNewDAcl = 0
        bError = True
        GoTo Cleanup
    End If
    '第一次调用给出的参数肯定返回这个错误，这样做的目的是为了创建新的安全描述符 hNewSd 而得到各项的长度
    If MakeAbsoluteSD(ByVal hOrigSd, ByVal hNewSd, dwSDLen, ByVal hOldDAcl, dwAclSize, ByVal hSacl, dwSaclSize, ByVal hSidOwner, dwSidOwnLen, ByVal hSidPrimary, dwSidPrimLen) = 0 Then
        lngErr = GetLastError()
        Debug.Print "GetLastError: " & lngErr
        Debug.Print "hNewSd: " & hNewSd
        Debug.Print "hNewDAcl: " & hNewDAcl
        'If lngErr = ERROR_INSUFFICIENT_BUFFER Then
            hOldDAcl = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwAclSize)
            hSacl = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwSaclSize)
            hSidOwner = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwSidOwnLen)
            hSidPrimary = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwSidPrimLen)
            hNewSd = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, ByVal dwSDLen)
            Debug.Print "调用MakeAbsoluteSD成功之后dwSDLen值为: " & dwSDLen
            '再次调用才可以成功创建新的安全描述符 hNewSd但新的安全描述符仍然是原访问控制列表 ACL
            If MakeAbsoluteSD(ByVal hOrigSd, ByVal hNewSd, dwSDLen, ByVal hOldDAcl, dwAclSize, ByVal hSacl, dwSaclSize, ByVal hSidOwner, dwSidOwnLen, ByVal hSidPrimary, dwSidPrimLen) = 0 Then
                bError = True
                GoTo Cleanup
            End If
            Debug.Print "hNewSd: " & hNewSd
            Debug.Print "hNewDAcl: " & hNewDAcl
'        Else
'            bError = True
'            GoTo Cleanup
'        End If
    End If

    '将具有所有访问权限的访问控制列表 hNewDAcl 加入到新的hNewSd中
    If SetSecurityDescriptorDacl(hNewSd, bDAcl, hNewDAcl, bDefDAcl) = 0 Then
        bError = True
        GoTo Cleanup
    End If

    '将新的安全描述符加到 TOKEN 中
    If SetKernelObjectSecurity(hToken, DACL_SECURITY_INFORMATION, ByVal hNewSd) = 0 Then
        bError = True
        GoTo Cleanup
    End If
    '以所有权限方式再次打开winlogon.exe为复制权限作准备
    If OpenProcessToken(ByVal hProcess, TOKEN_ALL_ACCESS, hToken) = 0 Then
        bError = True
        GoTo Cleanup
    End If

    '复制一份具有相同访问权限的 TOKEN
    If DuplicateTokenEx(hToken, TOKEN_ALL_ACCESS, ByVal 0, ByVal SecurityImpersonation, ByVal TokenPrimary, hNewToken) = 0 Then
        bError = True
        GoTo Cleanup
    End If
    '不虚拟登陆用户的话，创建新进程会提示1314 客户没有所需的特权错误
    Call ImpersonateLoggedOnUser(hNewToken)
    '利用具有所有权限的 TOKEN，创建高权限进程
    If CreateProcessAsUser(hNewToken, vbNullString, szProcessName, ByVal 0&, ByVal 0, False, ByVal 0&, vbNullString, vbNullString, si, pi) = 0 Then
        bError = True
        GoTo Cleanup
    End If
    bError = False
Cleanup:
'    On Error Resume Next
    If hOrigSd Then HeapFree GetProcessHeap, 0, hOrigSd
    If hNewSd Then HeapFree GetProcessHeap, 0, hNewSd
    If hSidPrimary Then HeapFree GetProcessHeap, 0, hSidPrimary
    If hSidOwner Then HeapFree GetProcessHeap, 0, hSidOwner
    If hSacl Then Call HeapFree(GetProcessHeap, 0, hSacl)
    If hOldDAcl Then Call HeapFree(GetProcessHeap, 0, hOldDAcl)
    Call CloseHandle(pi.hProcess)
    Call CloseHandle(pi.hThread)
    Call CloseHandle(hToken)
    Call CloseHandle(hNewToken)
    Call CloseHandle(hProcess)
    If (bError) Then
        CreateSystemProcess = False
    Else
        CreateSystemProcess = True
    End If
End Function

下面是工程

点击这里打包下载!