'---------------------------------------------------------------------------------------
' Module      : mIsAppSandboxed
' DateTime    : 01/07/2008 08:32
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://cobein27.googlepages.com/vb6
' Purpose     : Determine if the app is running into a sandbox
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' Reference   :
'
' History     : 01/07/2008 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit
 
Private Const STATUS_INFO_LENGTH_MISMATCH   As Long = &HC0000004
Private Const HEAP_ZERO_MEMORY              As Long = &H8
 
Private Type SYSTEM_HANDLE
    UniqueProcessId                         As Integer
    CreatorBackTraceIndex                   As Integer
    ObjectTypeIndex                         As Byte
    HandleAttributes                        As Byte
    HandleValue                             As Integer
    pObject                                 As Long
    GrantedAccess                           As Long
End Type
 
Private Type SYSTEM_HANDLE_INFORMATION
    uCount                                  As Long
    aSH()                                   As SYSTEM_HANDLE
End Type
 
Private Declare Function NtQuerySystemInformation Lib "NTDLL.DLL" (ByVal SystemInformationClass As Long, ByVal pSystemInformation As Long, ByVal SystemInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function NtQueryObject Lib "NTDLL.DLL" (ByVal ObjectHandle As Long, ByVal ObjectInformationClass As Long, ByVal ObjectInformation As Long, ByVal ObjectInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function lstrcpyW Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
 
Public Sub Main()
    MsgBox IsAppSandboxed
End Sub
 
Public Function IsAppSandboxed() As Boolean
    Dim lSize               As Long
    Dim bvBuff()            As Byte
    Dim tSHI                As SYSTEM_HANDLE_INFORMATION
    Dim i                   As Long
    Dim lPID                As Long
 
    lSize = 1024: ReDim bvBuff(lSize) 'this is because ReturnLength returns 0 :S
    Do While NtQuerySystemInformation(16, VarPtr(bvBuff(0)), ByVal lSize, 0&) = _
       STATUS_INFO_LENGTH_MISMATCH
        lSize = lSize * 2
        ReDim bvBuff(lSize)
    Loop
 
    Call CopyMemory(tSHI.uCount, bvBuff(0), &H4)
    ReDim tSHI.aSH(tSHI.uCount - 1)
    Call CopyMemory(tSHI.aSH(0), bvBuff(4), (tSHI.uCount - 1) * 16)
 
    lPID = GetCurrentProcessId
 
    For i = 0 To tSHI.uCount - 1
        If tSHI.aSH(i).UniqueProcessId = lPID Then 'Filter by local handles
            If tSHI.aSH(i).ObjectTypeIndex = 20 Then 'Filter by Key
                If InStr(1, GetLocalObjectName(tSHI.aSH(i).HandleValue), "SANDBOX_") Then
                    IsAppSandboxed = True
                    Exit for '<----EDIT
                End If
            End If
        End If
    Next
End Function
 
Public Function GetLocalObjectName(ByVal lHandle As Long) As String
    Dim lMem    As Long
    Dim sPath   As String
    Dim lSize  As Long
 
    lMem = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, &H1000)
    Call NtQueryObject(lHandle, 1, lMem, &H1000, lSize)
    Call HeapFree(GetProcessHeap, 0, lMem)
    If Not lSize > 8 Then Exit Function
    sPath = Space(lSize)
    Call lstrcpyW(sPath, lMem + &H8)
    sPath = StrConv(sPath, vbFromUnicode)
    GetLocalObjectName = Left$(sPath, lstrlen(sPath))
End Function