Visual Basic Foro
Programación => Visual Basic .NET / C# => Mensaje iniciado por: TOLO68 en Febrero 19, 2017, 11:51:43 am
-
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
-
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:
===================================================================================================================
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
-
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
-
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.