Funcion Leer Serial CPU en VB6 para .NET

[TOLO68]

Buenas a Todos

Tengo la siguiente funcion que me lee el serial del CPU en VB6

La he probado en un EXE compilado con VB6 desde varios computadores y no falla

Pero si la quiero usar en VB.Net no va bien, me da un error en CallWindowProc, diciendo que puede ser debido a un error de memoria, tengo el VB 2008

para ver el serial es por ej:

Debug.Print GetCPUSerialAPI

el dato que da es un Hexadecimal de 16 caracteres

Este mismo numero lo puedo leer con WMI tanto desde VB6 como VB.Net, pero el problema es que tarda unos segundos en leerlo, cosa que con la funcion que os pongo es instantaneo, si buscais en Google, "CallWindowProc CPUID VB6", hay varias webs con este codigo para ejecutar ASM desde VB6

-------------------------------------------------

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As String, ByRef hWnd As Long, ByRef Msg As Long, ByRef wParam As Long, ByRef lParam As Long) As Long

Private m_CPUAsm As String

Public Function GetCPUSerialAPI() As String
   Dim sOut As String
   Dim eax As Long, ebx As Long, ecx As Long, edx As Long
   
   Call CallWindowProc(CPUAsm, eax, ebx, ecx, edx)
   If eax > 0 Then
      eax = 1
      CallWindowProc CPUAsm, eax, ebx, ecx, edx
      If eax <> 0 Then sOut = Right("00000000" & Hex(eax), 8 )
      If edx <> 0 Then sOut = Right("00000000" & Hex(edx), 8 ) & sOut
      GetCPUSerialAPI = sOut
   End If
End Function

Private Function CPUAsm() As String
   If m_CPUAsm = "" Then
      Dim Asm As String
      Asm = Asm & Chr(&H56)                            '56        push   esi
      Asm = Asm & Chr(&H55)                            '55        push   ebp
      Asm = Asm & Chr(&H8B) & Chr(&HEC)                '8B EC     mov  ebp,esp
      Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&HC)     '8B 75 0C  mov  esi,dword ptr[ebp+0Ch]
      Asm = Asm & Chr(&H8B) & Chr(&H6)                 '8B 06     mov  eax,dword ptr[esi]
      Asm = Asm & Chr(&HF) & Chr(&HA2)                 '0F A2     cpuid
      Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&HC)     '8B 75 0C  mov  esi,dword ptr[ebp+0Ch]
      Asm = Asm & Chr(&H89) & Chr(&H6)                 '89 06     mov  dword ptr [esi],eax
      Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&H10)    '8B 75 10  mov  esi,dword ptr[ebp+10h]
      Asm = Asm & Chr(&H89) & Chr(&H1E)                '89 1E     mov  dword ptr [esi],ebx
      Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&H14)    '8B 75 14  mov  esi,dword ptr[ebp+14h]
      Asm = Asm & Chr(&H89) & Chr(&HE)                 '89 0E     mov  dword ptr [esi],ecx
      Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&H18)    '8B 75 18  mov  esi,dword ptr[ebp+18h]
      Asm = Asm & Chr(&H89) & Chr(&H16)                '89 16     mov  dword ptr [esi],edx
      Asm = Asm & Chr(&H5D)                            '5D        pop  ebp
      Asm = Asm & Chr(&H5E)                            '5E        pop  esi
      Asm = Asm & Chr(&HC2) & Chr(&H10) & Chr(&H0)     'C2 10 00  ret  10h
      m_CPUAsm = Asm
   End If
   CPUAsm = m_CPUAsm
End Function

[el_trocha]

Camarada he probado este modulo que encontre en un foro de microsoft.

En mi pc funciona correctamente, tengo un win7 64 bits

Te paso el codigo que encontre:

Código: [Seleccionar]

===================================================================================================================
EN EL FORM - UN BOTON Y UN LABEL
===================================================================================================================
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

Dim CPU As String
        CPU = GetWmiDeviceSingleValue("Win32_Processor", "ProcessorID")
        Label1.Text = CPU

End Sub

===================================================================================================================
EN UN MODULO
===================================================================================================================

Private m_mainWmi As Object
    Private m_deviceLists As Collection


Private Function GetMainWMIObject() As Object

        On Error GoTo eh

        If m_mainWmi Is Nothing Then

            m_mainWmi = GetObject("WinMgmts:")

        End If

        GetMainWMIObject = m_mainWmi

        Exit Function

eh:

        GetMainWMIObject = Nothing
   
End Function

Public Function WmiIsAvailable() As Boolean

        WmiIsAvailable = CBool(Not GetMainWMIObject() Is Nothing)


End Function

Public Function GetWmiDeviceSingleValue(ByVal WmiClass As String, ByVal WmiProperty As String) As String

        On Error GoTo done

        Dim result As String

        Dim wmiclassObjList As Object

        wmiclassObjList = GetWmiDeviceList(WmiClass)

        Dim wmiclassObj As Object

        For Each wmiclassObj In wmiclassObjList

            result = CallByName(wmiclassObj, WmiProperty, vbGet)

            Exit For

        Next

done:
        GetWmiDeviceSingleValue = Trim(result)


End Function


Public Function GetWmiDeviceList(ByVal WmiClass As String) As Object
       
If m_deviceLists Is Nothing Then
       
    m_deviceLists = New Collection
       
End If

        On Error GoTo fetchNew

        GetWmiDeviceList = m_deviceLists.Item(WmiClass)

        Exit Function

fetchNew:

        Dim devList As Object

        devList = GetWmiDeviceListInternal(WmiClass)

        If Not devList Is Nothing Then

            Call m_deviceLists.Add(devList, WmiClass)

        End If

        GetWmiDeviceList = devList

End Function

Private Function GetWmiDeviceListInternal(ByVal WmiClass As String) As Object
   

On Error GoTo eh

        GetWmiDeviceListInternal = GetMainWMIObject.Instancesof(WmiClass)

        Exit Function

eh:

        GetWmiDeviceListInternal = Nothing

End Function


[TOLO68]

el_trocha muchas gracias por el codigo.

Este tambien a mi me funciona porque lo lee con WMI, el problema es que tarda unos segundos en leer, supongo que a ti tb te hara lo mismo.

En cambio el que puse yo lo ejecuta en ASM y la lectura es instantanea, me imagino que es porque no tiene que recorrer todos los datos de WMI

Saludos

[el_trocha]

Si es correcto.

Y en cuanto a la tardanza en entregar el dato, es practicamente instantanea.

Tambien depende mucho de los recursos de la maquina que ejecute el codigo.

Si te ha servido estupendo.

Un saludo.