MachCode

Option Explicit
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private x As Long
Public Function GetCpuName() As String

Dim MachineCode(0 To 35) As Byte
Dim VarAddr As Long
Dim FunctAddr As Long
Dim EAX As Long
Dim CPUName(1 To 12) As Byte

'set up machine code


MachineCode(0) = &H55 'push ebp

MachineCode(1) = &H8B 'move ebp,esp
MachineCode(2) = &HEC

MachineCode(3) = &H57 'push edi

MachineCode(4) = &H52 'push edx

MachineCode(5) = &H51 'push ecx

MachineCode(6) = &H53 'push ebx

MachineCode(7) = &H8B 'move eax,dword ptr [ebp+8]
MachineCode(8) = &H45
MachineCode(9) = &H8

MachineCode(10) = &HF 'cpuid
MachineCode(11) = &HA2

MachineCode(12) = &H8B 'mov edi,dword ptr [ebp+12]
MachineCode(13) = &H7D
MachineCode(14) = &HC

MachineCode(15) = &H89 'move dword ptr [edi],ebx
MachineCode(16) = &H1F

MachineCode(17) = &H8B 'mov edi,dword ptr [ebp+16]
MachineCode(18) = &H7D
MachineCode(19) = &H10

MachineCode(20) = &H89 'move dword ptr [edi],ecx
MachineCode(21) = &HF

MachineCode(22) = &H8B 'mov edi,dword ptr [ebp+20]
MachineCode(23) = &H7D
MachineCode(24) = &H14

MachineCode(25) = &H89 'move dword ptr [edi],edx
MachineCode(26) = &H17

MachineCode(27) = &H58 'pop ebx
MachineCode(28) = &H59 'pop ecx
MachineCode(29) = &H5A 'pop edx
MachineCode(30) = &H55 'pop edi

MachineCode(31) = &HC9 'leave
MachineCode(32) = &HC2 'ret 16 I tried everything from 0 to 24
MachineCode(33) = &H10 ' but all produce the stack error
MachineCode(34) = &H0

'tell cpuid what we want

EAX = 0

'get address of Machine Code

VarAddr = VarPtr(MachineCode(0))

'get address of Sub Dummy

FunctAddr = GetAddress(AddressOf Dummy)

'copy the Machine Code to where it can be called

CopyMemory ByVal FunctAddr, ByVal VarAddr, 35 '35 bytes machine code

'call it

On Error Resume Next 'apparently it gets a stack pointer error when in P-Code but i dont know why
CallWindowProc FunctAddr, EAX, VarPtr(CPUName(1)), VarPtr(CPUName(9)), VarPtr(CPUName(5))
'Debug.Print Err; Err.Description

'MsgBox Err & Err.Description

On Error GoTo 0

GetCpuName = StrConv(CPUName(), vbUnicode) 'UnicodeName

End Function

Private Function GetAddress(Address As Long) As Long
GetAddress = Address
End Function

Private Sub Dummy()
'the code below just reserves some space to copy the machine code into

'it is never executed

x = 0
x = 1
x = 2
x = 3
x = 4
x = 5
x = 6
x = 7
x = 8
x = 9
x = 10
x = 0
x = 1
x = 2
x = 3
x = 4
x = 5
x = 6
x = 7
x = 8
x = 9
x = 10

End Sub

'Example


Label1 = GetCpuName() & " CPU"
Label2 = "You have a" & IIf(InStr("AEIOU", Left$(Label1, 1)), "n", "")
This shows how to incorporate machine code into VB
The example fills the array with a few machine instructions
and then copies them to a procedure address.
The modified procedure is then called thru CallWindowProc.
The result of this specific machine code is your CPU Vendor
Name.

Apparently it gets a Stack Pointer Error, but I don't know
why; if anybody can fix that please let me know... UMGEDV@AOL.COM
The Error is not present in the native compiled version;
so I think it got something to do with the P-Code Calling
Convention (strange though)...

Sub Dummy serves to reserve some space to copy the machine
instructions into.

Tested on Intel and AMD CPU's (uncompiled and compiled)