Date de création : 01/02/2007 à 17:12:00 7 Commentaire(s)

sebdraluorg

Ce code permet d'obtenir et de modifier le mask d'affinité d'un processus ou d'un thread

Je sais qu'il y a les Api SetProcessAffinityMask GetProcessAffinityMask pour recuperer et modifier le mask d'un process, mais il n'y a pas d'api GetThreadAffinityMask et il faut donc passer par les api NT et tant qu'a faire je l'ai fait pour les process aussi...

Pour Info:
Le mask d'affinité défini sur quel CPU ou Core un thread ou process doit s'executer

Fonctionnement des masques d'affinité

Première chose, les <> cores et cpu sont nommés en commencant a 0 jusque N -1

Le masque pour un core est: 2 ^ CoreIndex

Donc par exemple pour le core 0 (premier core) on aura le masque
Masque = (2 ^ 0) = 1

Pour definir plusieurs cores on additionne simplement le mask des <> core
Exemple pour le core 0 et 1
Masque = (2 ^ 0) + (2 ^ 1) = 3

Remarque vous ne pouvez pas affecter un thread sur le core 0 si le processus est sur le core 1 uniquement! dans ce cas il faut soit affecter le process sur les 2 cores soit sur le core 0...

Private Declare Function NtQueryInformationProcess Lib "Ntdll.dll" (ByVal hProcess As Long, ByVal ProcessInformationClass As Long, ByVal ProcessInformation As Long, ByVal ProcessInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function NtSetInformationProcess Lib "Ntdll.dll" (ByVal hProcess As Long, ByVal ProcessInformationClass As Long, ByVal ProcessInformation As Long, ByVal ProcessInformationLength As Long) As Long

Private Declare Function NtQueryInformationThread Lib "Ntdll.dll" (ByVal hThread As Long, ByVal ThreadInformationClass As Long, ByVal ThreadInformation As Long, ByVal ThreadInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function NtSetInformationThread Lib "Ntdll.dll" (ByVal hThread As Long, ByVal ThreadInformationClass As Long, ByVal ThreadInformation As Long, ByVal ThreadInformationLength As Long) As Long

Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function OpenThread Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Const PROCESS_SET_INFORMATION = &H200
Public Const PROCESS_QUERY_INFORMATION = &H400

Public Const THREAD_SET_INFORMATION = &H20
Public Const THREAD_QUERY_INFORMATION = &H40

Private Type CLIENT_ID
    UniqueProcess   As Long
    UniqueThread    As Long
End Type

Private Type PROCESS_BASIC_INFORMATION
    ExitStatus      As Long
    PEBBaseAddress  As Long
    AffinityMask    As Long
    BasePriority    As Long
    UniqueProcessId As Long
    ParentProcessId As Long
End Type

Private Type THREAD_BASIC_INFORMATION
    ExitStatus      As Long
    TebBaseAddress  As Long
    ClientId        As CLIENT_ID
    AffinityMask    As Long
    Priority        As Long
    BasePriority    As Long
End Type


Public Function GetThreadMask(ByVal ThreadId As Long) As long

    Dim hThread As Long
    Dim TBI As THREAD_BASIC_INFORMATION
   
    hThread = OpenThread(THREAD_QUERY_INFORMATION, False, ThreadId)
   
    If hThread Then
        NtQueryInformationThread hThread, 0&, VarPtr(TBI), Len(TBI), ByVal 0&
        GetThreadMask = TBI.AffinityMask
        CloseHandle hThread
    End If
   
End Function

Public Function SetThreadMask(ByVal ThreadId As Long, ByVal Mask As long) As Long
 
    Dim hThread As Long
   
    hThread = OpenThread(THREAD_SET_INFORMATION, False, ThreadId)
   
    If hThread Then
        SetThreadMask = NtSetInformationThread(hThread, 4&, VarPtr(Mask), Len(Mask))
        CloseHandle hThread
    End If
 
End Function


Public Function GetProcessMask(ByVal ProcessId As Long) As long

    Dim hProcess    As Long
    Dim PBI         As PROCESS_BASIC_INFORMATION
   
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId)
   
    If hProcess Then
        NtQueryInformationProcess hProcess, 0&, VarPtr(PBI), Len(PBI), ByVal 0&
        GetProcessMask = PBI.AffinityMask
        CloseHandle hProcess
    End If
   
End Function

Public Function SetProcessMask(ByVal ProcessId As Long, ByVal Mask As long) As Long
 
    Dim hProcess As Long
   
    hProcess = OpenProcess(PROCESS_SET_INFORMATION, False, ProcessId)
   
    If hProcess Then
        SetProcessMask = NtSetInformationProcess(hProcess, 21&, VarPtr(Mask), Len(Mask))
        CloseHandle hProcess
    End If
 
End Function

Private Function CoreListToString(CoreList() As Byte) As String
   
    Dim i As Byte
   
    On Error GoTo ErrInvalid
   
    For i = LBound(CoreList) To UBound(CoreList)
        CoreListToString = CoreListToString & CoreList(i) & ","
    Next i
   
    CoreListToString = Left(CoreListToString, Len(CoreListToString) - 1)
    Exit Function
   
ErrInvalid:
    CoreListToString = ""
End Function

Private Function CoreListToByteArray(CoreList As String) As Byte()

    Dim s() As String
    Dim b() As Byte
    Dim i  As Integer
   
    If CoreList = "" Then Exit Function
   
    s = Split(CoreList, ",")
    ReDim b(UBound(s))
   
    For i = 0 To UBound(b)
        b(i) = CByte(s(i))
    Next i
   
    Erase s
    CoreListToByteArray = b
   
End Function


Private Function GetCoreListFromMask(Mask As Long, CoreList() As Byte) As Integer
   
    Dim MaxCore    As Byte
    Dim CoreCount  As Byte
    Dim i          As Byte
    Dim Value      As Long
   
    MaxCore = 16
   
    For i = 0 To MaxCore - 1
        Value = (2 ^ i)
        If Mask < Value Then Exit For
        If Mask And Value Then
            ReDim Preserve CoreList(CoreCount)
            CoreList(CoreCount) = i
            CoreCount = CoreCount + 1
        End If
    Next i
   
    GetCoreListFromMask = CoreCount
   
End Function

Private Function GetMaskFromCoreList(CoreList() As Byte) As Long
   
    Dim i As Byte
   
    On Error GoTo ErrInvalide
   
    For i = LBound(CoreList) To UBound(CoreList)
        GetMaskFromCoreList = GetMaskFromCoreList + 2 ^ CoreList(i)
    Next i
   
    Exit Function
   
ErrInvalide:
    GetMaskFromCoreList = -1
End Function

Voici l'historique des modifications de ce code :

Le 03/02/2007 par sebdraluorg : correction ortografik
Le 14/04/2007 par sebdraluorg : -Ajout des fonction pour recuperer la liste des cores depuis un masque et inversement
-supporte maintenant jusqua 16 processeurs ou Core

Vous devez être connecté pour pouvoir poster un commentaire.