Option _Explicit



Declare Dynamic Library "kernel32"

    Function GetLogicalProcessorInformation& (ByVal Buffer As _Offset, ReturnLength As _Unsigned Long)

    Function GetLastError~& ()

End Declare



Const RelationProcessorCore~& = 0

Const ERROR_INSUFFICIENT_BUFFER~& = 122



Print "Physical Cores: "; CpuCoreCount

Print "CPU logical Threads: "; CpuLogicalCount

End















Function CpuCoreCount& ()

    Dim ok As Long

    Dim retLen As _Unsigned Long

    Dim er As _Unsigned Long

    Dim mem As _MEM

    Dim ptrSize As Long, entrySize As Long

    Dim countEntries As Long, i As Long

    Dim rel As _Unsigned Long

    Dim cores As Long



    $If 64BIT Then

        ptrSize = 8

        entrySize = 32

    $Else

        ptrSize = 4

        entrySize = 24

    $End If



    retLen = 0

    ok = GetLogicalProcessorInformation(0, retLen)

    er = GetLastError



    If er <> ERROR_INSUFFICIENT_BUFFER Or retLen = 0 Then

        CpuCoreCount = 0

        Exit Function

    End If



    mem = _MemNew(retLen)

    ok = GetLogicalProcessorInformation(mem.OFFSET, retLen)

    If ok = 0 Then

        _MemFree mem

        CpuCoreCount = 0

        Exit Function

    End If



    countEntries = retLen \ entrySize

    cores = 0



    For i = 0 To countEntries - 1

        rel = _MemGet(mem, mem.OFFSET + i * entrySize + ptrSize, _Unsigned Long)

        If rel = RelationProcessorCore Then cores = cores + 1

    Next i



    _MemFree mem

    CpuCoreCount = cores

End Function





Function CpuLogicalCount& ()

    Dim ok As Long

    Dim retLen As _Unsigned Long

    Dim er As _Unsigned Long

    Dim mem As _MEM

    Dim ptrSize As Long, entrySize As Long

    Dim countEntries As Long, i As Long

    Dim rel As _Unsigned Long

    Dim logical As Long

    Dim mask64 As _Unsigned _Integer64

    Dim tmp As _Unsigned _Integer64



    $If 64BIT Then

        ptrSize = 8

        entrySize = 32

    $Else

        ptrSize = 4

        entrySize = 24

    $End If



    retLen = 0

    ok = GetLogicalProcessorInformation(0, retLen)

    er = GetLastError



    If er <> ERROR_INSUFFICIENT_BUFFER Or retLen = 0 Then

        CpuLogicalCount = 0

        Exit Function

    End If



    mem = _MemNew(retLen)

    ok = GetLogicalProcessorInformation(mem.OFFSET, retLen)

    If ok = 0 Then

        _MemFree mem

        CpuLogicalCount = 0

        Exit Function

    End If



    countEntries = retLen \ entrySize

    logical = 0



    For i = 0 To countEntries - 1

        rel = _MemGet(mem, mem.OFFSET + i * entrySize + ptrSize, _Unsigned Long)

        If rel = RelationProcessorCore Then

            If ptrSize = 8 Then

                mask64 = _MemGet(mem, mem.OFFSET + i * entrySize, _Unsigned _Integer64)

            Else

                mask64 = _MemGet(mem, mem.OFFSET + i * entrySize, _Unsigned Long)

            End If



            tmp = mask64

            Do While tmp <> 0

                tmp = tmp And (tmp - 1)

                logical = logical + 1

            Loop

        End If

    Next i



    _MemFree mem

    CpuLogicalCount = logical

End Function