Jak użyć funkcji NtSetInformationProcess w Delphi 7 ?

Tak się składa że muszę zmienić po uruchomieniu mojej aplikacji łącze NUMA do której została przypisana automatycznie przez system.
Mógłbym zawczasu to wymusić przez standardowe

start /NODE 3 /AFFINITY 1 Mój_Program.exe

ale koniecznie chcę to zrobić już po uruchomieniu swojego programu. Innymi słowy chcę aby użytkownik mógł sam ustawić na jakim łączu ma pracować program bez zabawy w Task Manager. Podobny problem już pojawił się na oficjalnym forum microsoftu i okazało się że trzeba użyć nieudokumentowanej (przez microsoft) funkcji NtSetProcessInformation.

https://social.msdn.microsoft.com/Forums/windowsdesktop/en-US/e0f49cda-4cbf-4da0-918a-0568271edb9f/process-affinity-on-a-system-with-128-processors?forum=wdk

Naszczęście funkcja została udokumentowana przez ludzi z ReactOS
https://undocumented.ntinternals.net/index.html?page=UserMode%2FUndocumented%20Functions%2FNT%20Objects%2FProcess%2FNtSetInformationProcess.html

Teraz próbuję to samo zrobić w Delphi 7 co ten jegomość w C++:

I found an interesting API which is essentally what I want.

The goal here was to do the same thing as SetProcessAffinityMask() with groups. As it turns out, there is such a function, but it is undocumented.

I discovered that NtSetProcessInformation() will set both the group and affinity mask for an already running process. It's API is something like this:

GROUP_AFFINITY group_affinity;

group_affinity.group = 1; // Second group of 64 processors

group_affinity.mask = 0x0000FFFF00000000;

NtSetProcessInformation (hProcess, 0x15, &group_affinity, group_affinity_size)

It works very well and is the same API that TaskManager uses to change the affinity group and mask of processes.

Of course, since it is undocumented, it is subject to change, so it is best not to employ this in retail software. I am using it only to run performance tests in our lab, so no big problem here.

Importowanie funkcji z ntdll.dll oraz definiowanie rekordu

function NtSetInformationProcess(HProcess: CARDINAL; ProcessInformationClass: BYTE; ProcessInformation: POINTER; ProcessInformationLength: CARDINAL): CARDINAL; stdcall; external 'ntdll.dll' name 'NtSetInformationProcess';

type
   TGROUP_AFFINITY = record
     mask   : cardinal;
     group  : cardinal;
   end;

kod właściwy na szybkensa dla celów testowych w FormCreate:

procedure TForm1.FormCreate(Sender: TObject);
var group_affinity:TGROUP_AFFINITY;
    HRES: HRESULT; 
begin
                       // do celów testowych chcę przypisać proces do pierwszego rdzenia ,pierwszej grupy
  group_affinity.group:= 0; //grupa pierwsza
  group_affinity.mask:= 1; //pierwszy rdzeń

  HRES:=NtSetInformationProcess(GetCurrentProcess(), $15 , @group_affinity, SizeOf(group_affinity));

  if HRES = S_OK then showmessage('OK')
  else showmessage('ERROR');
  
end;

No i pupa na razie bo zawsze dostaje informacje ERROR po wykonaniu tej funkcji. Obstawiam że coś skopałem z danymi wejściowymi do funkcji (inna struktura wymagana). Pewnie wymagane jest coś takiego https://docs.microsoft.com/en-us/windows/desktop/api/winnt/ns-winnt-_group_affinity

Jest tu może jakaś osoba ,która już wcześniej korzystała z tej egzotycznej funkcji?

Po mojemu to:

function NtSetInformationProcess(HProcess: THANDLE; ProcessInformationClass: DWORD; ProcessInformation: POINTER; ProcessInformationLength: ULONG): CARDINAL; stdcall; external 'ntdll.dll' name 'NtSetInformationProcess';

nope...

A to TGROUP_AFFINITY jest na pewno dobrze?

Podejrzewam że nie i tu jest pies pogrzebany (moja zgadywanka). Funkcja nie jest karmiona tym czym trzeba :(

Z tego co widzę to będzie chyba to:
https://docs.microsoft.com/en-us/windows/desktop/api/winnt/ns-winnt-_group_affinity
czyli po mojemu:

   TGROUP_AFFINITY = record
     Mask : ULONG;
     Group  : WORD;
     Reserved: array [0..2] of WORD;
   end;

BINGOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO !!!!!
Działa! Sprawdziłem affinity mask w Task Managerze i jest poprawnie ustawione na pierwszy rdzeń.
Ale żeś mnie teraz uszczęśliwił! Wielkie dzięki. Nawet mastachy na stackoverflow wymiękli na samym starcie!

Okazuje się że ta brakująca konkretna linijka musi być!

Reserved: array [0..2] of WORD;

no i

Group  : WORD;

zamiast

Group  : cardinal;

Byte i WORD działają. Cardinal już nie.

Tak zmieniłem na WORD. Masz rację nie ma co kombinować.

Atak_Snajpera napisał(a):

Byte i WORD działają. Cardinal już nie.

Nie strzelaj – trzymaj się dokumentacji. Choć i tak dziwi mnie że z Cardinalem nie działa – w końcu nie używasz pakowania dla tego rekordu, więc jego zawartość zostanie wyrównana (pewnie do rozmiaru ULONG).

Skoro już i tak zgadujesz, to spróbuj spakować ten rekord. ;)

Zgadywałem bo wcześniej nie natknąłem się na to https://docs.microsoft.com/en-us/windows/desktop/api/winnt/ns-winnt-_group_affinity
Gdybym tego tu nie wkleił to pewnie nadal bylibyśmy w lesie.
Ciężko tak od razu zrobić wszystko żeby działało po jednym poście z microsoftowego forum.

Okazuje się że zbyt szybko witałem się z gąską.

Kod działa ale tylko w FormCreate. Wystarczy go wykonać gdzie indziej np. form.show lub w przycisku i jest znowu ERROR.

CurrentPID:=GetCurrentProcessID;
ProcessHandle:=OpenProcess(PROCESS_SET_INFORMATION,False,CurrentPID); // <-PROCESS_SET_INFORMATION jest najwyraźniej powyżej dopuszczalnego poziomu
HRES:=NtSetInformationProcess(ProcessHandle, $15 , @group_affinity, SizeOf(group_affinity));

Wygląda na to że będę musiał jeszcze przydzielić odpowiednie uprawnienia za pomocą SeDebugPrivilege

To open a handle to another process and obtain full access rights, you must enable the SeDebugPrivilege privilege.
https://docs.microsoft.com/en-us/windows/desktop/ProcThread/process-security-and-access-rights

Taraz czeka mnie walka z tłumaczeniem częsci kodu z tego przykładu
https://support.microsoft.com/en-us/help/131065/how-to-obtain-a-handle-to-any-process-with-sedebugprivilege