Option Explicit
 
'---------------------------------------------------------------------------------------
' Module    : mAntiVirtualPC
' Author    : Karcrack
' Now$      : 06/09/2009  17:35
' Used for? : Known if being Virtualized inside M$ Virtual PC
' Thanks    : Kiash > He tested on Virtual PC
' Original C source:
'    BOOL IsVirtualPC(void){
'        __try{
'            __asm{
'                mov eax, 1
'                _emit 0x0F
'                _emit 0x3F
'                _emit 0x07
'                _emit 0x0B
'                _emit 0xC7
'                _emit 0x45
'                _emit 0xFC
'                _emit 0xFF
'                _emit 0xFF
'                _emit 0xFF
'                _emit 0xFF
'            }
'        }__except(1){
'            return FALSE;
'        }
'        return TRUE;
'    }
'---------------------------------------------------------------------------------------
 
'KERNEL32
Private Declare Function SetUnhandledExceptionFilter Lib "KERNEL32" (ByVal lpTopLevelExceptionFilter As Long) As Long
'USER32
Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'MSVBVM60
Private Declare Sub PutMem8 Lib "MSVBVM60" (inDst As Any, ByVal inSrc As Currency)
 
Private Const THUNK_ANTI1       As Currency = -104917872100.9905@           'db 0x0F, 0x3F,0x07,0x0B,0xC7,0x45,0xFC,0xFF
Private Const THUNK_ANTI2       As Currency = -802975918416356.9665@        'db 0xFF,0xFF,0xFF + RET + NOP + NOP + NOP + NOP
 
Private m_bFlag                 As Boolean
 
Public Function IsVirtualPC() As Boolean
    On Error Resume Next
    Dim bvASM(&HF)              As Byte
    Dim lOldSEH                 As Long
 
    m_bFlag = True
    lOldSEH = SetUnhandledExceptionFilter(AddressOf ExceptionHandler)
 
    Call PutMem8(ByVal VarPtr(bvASM(0)), THUNK_ANTI1)
    Call PutMem8(ByVal VarPtr(bvASM(0)) + 8, THUNK_ANTI2)
 
    Call CallWindowProc(VarPtr(bvASM(0)), 0&, 0&, 0&, 0&)
 
    Call SetUnhandledExceptionFilter(lOldSEH)
    IsVirtualPC = m_bFlag
End Function
 
Public Function ExceptionHandler(ByRef uException As Long) As Long
    m_bFlag = False: ExceptionHandler = -1
    ' VB Will process our error :P
    Call Mid$(vbNullString, 0)
End Function