Visual Basic Module Anti-virtuale

[Crypt3r]

Yo probado con Virtual Pc y Vmware funciona bien

No sé quién es el autor

>Option Explicit

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hObject As Long)
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Const TH32CS_SNAPPROCESS = &H2
Private Const MAX_PATH As Long = 260

Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type

Function USER()
 Dim A As Object
 Dim B As Object
 Dim C As String
                       
C = "SELECT * FROM Win32_VideoController"
 Set A = GetObject("winmgmts:").ExecQuery(C)
 
 For Each B In A
   Select Case B.Description
   
       Case "VM Additions S3 Trio32/64"
        MsgBox "Virtual machine detected", vbCritical, "Anti virtuale"
       End
 
       Case "S3 Trio32/64"
       MsgBox "Virtual machine detected", vbCritical, "Anti virtuale"
       End
       
       Case "VirtualBox Graphics Adapter"
        MsgBox "Virtual machine detected", vbCritical, "Anti virtuale"
       End
       
       Case "VMware SVGA II"
       MsgBox "Virtual machine detected", vbCritical, "Anti virtuale"
       End

       Case ""
      MsgBox "Virtual machine detected", vbCritical, "Anti virtuale"
       End
       
       Case Else
      
   End Select

Next
End Function
Public Function Sandboxed() As Boolean
   Dim hMod As Long
   hMod = GetModuleHandle("SbieDll.dll")
   If hMod = 0 Then
       Sandboxed = False
   Else
       Sandboxed = True
   End If
End Function