[Source] IsVirtualPCPresent() - Sistema AntiVirtualPC

[cobein]

Un comentario acerca del code, seria coveniente agregar control de errores porque en algunos sistemas al tratar de acceder a WMI nos da error. Por lo me nos en vista con una cuenta restringida.

[Mad Antrax]

Un comentario acerca del code, seria coveniente agregar control de errores porque en algunos sistemas al tratar de acceder a WMI nos da error. Por lo me nos en vista con una cuenta restringida.

Vaya, no lo sabia...

De todas formas he mejorado la función. Ahora es capaz de discriminar bajo que entorno de virtualización se encuentra nuestra aplicación, el control de errores devuelve -1, permitiendo al usuario seguir ejecutando o no su soft cuando no ha sido posible detectar una VirtualMachine.

Esta noche posteo la función mejorada. Saludos!!

[invisible_hack]

Muy weno, te veo muy animado con todos estos codigos ultimamente eh? 

[cobein]

Me tome la libertad de modificar el code para detectar tambien Sun VirtualBox, lo testie en ubuntu corriendo un XP SP2

Código (vb) [Seleccionar] Expandir


Function IsVirtualPCPresent() As Boolean
    Dim DetectVirtualPC As String

    Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set HDS = WMI.ExecQuery("Select * from Win32_DiskDrive")

    DetectVirtualPC = ""
    For Each objHDS In HDS
        DetectVirtualPC = DetectVirtualPC & objHDS.Caption & objHDS.Model & objHDS.PNPDeviceID
    Next

    DetectVirtualPC = UCase(DetectVirtualPC)
   
    Select Case True
        Case DetectVirtualPC Like "*VIRTUAL*"
            IsVirtualPCPresent = True
        Case DetectVirtualPC Like "*VBOX*"
            IsVirtualPCPresent = True
    End Select

End Function