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
Private Sub Command1_Click()
Debug.Print GetCPUSerialAPI
End Sub
el serial del cpu en 16 caracteres hexadecimales.