Me puse a cureosear un poco despues de ver este post y vi otra manera de ver si nuestra aplicacion esta corriendo en una sandbox, no se que tan buena sera pero al parecer funciona correctamente con Sandboxie.
La mecanica es simple, todas las claves, archivos, semaforos, etc. son redireccionados por el sandbox, asi que simplemente escaneando las claves abiertas por nuetra aplicacion podemos ver que estan redireccionadas a la hive creada por el sandbox.
Lo dejo como curiosidad
'---------------------------------------------------------------------------------------
' 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
Mostrar Mensajes
