AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Sonstige Fragen zu Delphi Delphi Externe Exe starten und dieser einen best. Kern zuweisen
Thema durchsuchen
Ansicht
Themen-Optionen

Externe Exe starten und dieser einen best. Kern zuweisen

Ein Thema von Aurelius · begonnen am 2. Okt 2007 · letzter Beitrag vom 1. Feb 2011
Antwort Antwort
Seite 2 von 2     12   
Benutzerbild von Aurelius
Aurelius

Registriert seit: 29. Jan 2007
Ort: Erfurt
753 Beiträge
 
Delphi 7 Personal
 
#11

Re: Externe Exe starten und dieser einen best. Kern zuweisen

  Alt 3. Okt 2007, 09:39
Großes Dankeschön, ich schaus mir mal an!

Mein Problem war es ja ans ProzessHandle zu kommen

Werd mich nochmal melden wenn es Probleme geben sollte...
Jonas
  Mit Zitat antworten Zitat
Benutzerbild von Zacherl
Zacherl

Registriert seit: 3. Sep 2004
4.629 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#12

Re: Externe Exe starten und dieser einen best. Kern zuweisen

  Alt 3. Okt 2007, 14:55
CreateProcess liefert dir sicher ein ProcessHandle.
  Mit Zitat antworten Zitat
thafuba

Registriert seit: 15. Mai 2009
3 Beiträge
 
#13

Re: Externe Exe starten und dieser einen best. Kern zuweisen

  Alt 25. Sep 2009, 00:01
Zitat von sk0r:
Mit SetProcessAffinityMask kannst du einem Prozess eine Anzhal an zugehörigen CPUs zuweisen.
Mehr gibts da auch gar nicht zu erklären. Ich bin selbst erstaunt, dass es nur die eine API
benötigt, um eine CPU Zugehörigkeit zuzuweisen. Ach ja: Bei meinen Tests gibt SetProcessAffinityMask
auch 'true' zurück, wenn man eine Anzahl höher als die eigentlichen zur Verfügung stehen
CPUs hat. Deshalb habe ich dort einen Check eingebaut.

Delphi-Quellcode:
function GetActiveProcessorCount:Cardinal;
var
  lpSystemInfo: TSystemInfo;
begin
  GetSystemInfo(lpSystemInfo);
  result := lpSystemInfo.dwNumberOfProcessors
end;

function CreateProcessCPUKernel(lpProcessName, lpProcessParams: PChar; iProcessorNumb: Cardinal):LongBool;
var
  SUInfo: TStartupInfo;
  PIInfo: TPRocessInformation;
  lpSystemInfo: TSystemInfo;
begin
  result := not true;
  if iProcessorNumb = 0 then exit;
  FillChar(SUInfo, sizeof(SUInfo), #0);
  FillChar(PIInfo, sizeof(PIInfo), #0);
  GetSystemInfo(lpSystemInfo);
  if CreateProcess(lpProcessName, lpProcessParams, nil, nil, false, NORMAL_PRIORITY_CLASS or PROCESS_SET_INFORMATION, nil, PChar(ExtractFilePath(lpProcessName)), SUInfo, PIInfo) then
  begin
    if iProcessorNumb > lpSystemInfo.dwNumberOfProcessors then
      iProcessorNumb := lpSystemInfo.dwNumberOfProcessors;
    if SetProcessAffinityMask(PIInfo.hProcess, iProcessorNumb) then
    begin
      result := true;
    end;
  end;
end;

function SetProcessCPUKernel(lpProcId, iKernelNumb: Cardinal):LongBool;
var
  hProc: Cardinal;
  lpSystemInfo: TSystemInfo;
begin
  result := not true;
  if (lpProcId = 0) or (iKernelNumb = 0) then exit;
  hProc := OpenProcess(PROCESS_ALL_ACCESS or PROCESS_SET_INFORMATION, not true, lpProcId);
  if hProc <> 0 then
  begin
    GetSystemInfo(lpSystemInfo);
    if iKernelNumb > lpSystemInfo.dwNumberOfProcessors then
      iKernelNumb := lpSystemInfo.dwNumberOfProcessors;
    if SetProcessAffinityMask(hProc, iKernelNumb) then
    begin
      result := true;
    end;
    CloseHandle(hProc);
  end;
end;
Ich hoffe, ich konnte dir helfen. Der Code sollte sich von selbst erklären.
Man erstellt den gewünschten Prozess mit Hilfe von CreateProcess. Dort bekommt
man das Prozess-Handle über die TProcessInformation Struktur (TProcessInformation.hProcess).
Den übergibt man SetProcessAffinityMask als ersten Parameter und als zweiten
Parameter die Anzahl der CPUs. Aber bitte bei Eins anfangen, denn man zählt
in diesem Fall nicht von Null an, da man ja nicht weniger als eine CPU haben kann. :p

MfG: sk0r
dein Code funktioniert mit Dual-Core Systemen und wenn man nur einen Kern ansprechen will.
Bei Multi-Core Systemen mit mehr als 2 Kernen und wo man möglicherweise mehrere Kerne gleichzeitig Ansprechen will leider nicht.
denn bei "iProcessorNumb" wird nicht die anzahl der Kerne direkt angegeben, sondern einen Wert mit dem auch alle Kerne Gleichzeitig angesprochen werden können.
Aber dein code hat mich angespornt das mal genau anzusehen

Hier mein Vorschlag zu CreateProcessCPUKernel:
Delphi-Quellcode:
function CreateProcessCPUKernel(lpProcessName, lpProcessParams: PChar; iCoreVal: Cardinal; iCreationFlags: Cardinal = NORMAL_PRIORITY_CLASS): LongBool;
var
  SUInfo: TStartupInfo;
  PIInfo: TPRocessInformation;
  lpSystemInfo: TSystemInfo;
  i, CoreValue: Cardinal;
begin
  Result := False;
  CoreValue:=0;
  FillChar(SUInfo, sizeof(SUInfo), #0);
  FillChar(PIInfo, sizeof(PIInfo), #0);
  GetSystemInfo(lpSystemInfo);
  for i:=0 to lpSystemInfo.dwNumberOfProcessors-1 do CoreValue:=CoreValue+(1 shl i);
  if iCoreVal > CoreValue then iCoreVal:=CoreValue;
  if CreateProcess(lpProcessName, lpProcessParams, nil, nil, false, iCreationFlags or PROCESS_SET_INFORMATION, nil, PChar(ExtractFilePath(lpProcessName)), SUInfo, PIInfo) then
  begin
    Result := SetProcessAffinityMask(PIInfo.hProcess, iCoreVal);
  end;
end;
hier mein Vorschlag zu SetProcessCPUKernelByID:
Delphi-Quellcode:
function SetProcessCPUKernelByID(lpProcId, iCoreVal: Cardinal):LongBool;
var
  hProc, i, CoreValue: Cardinal;
  lpSystemInfo: TSystemInfo;
begin
  Result := False;
  CoreValue:=0;
  if (not lpProcId <> 0) then exit;
  hProc := OpenProcess(PROCESS_ALL_ACCESS or PROCESS_SET_INFORMATION, not true, lpProcId);
  if hProc <> 0 then
  begin
    GetSystemInfo(lpSystemInfo);
    for i:=0 to lpSystemInfo.dwNumberOfProcessors-1 do CoreValue:=CoreValue+(1 shl i);
    if iCoreVal > CoreValue then iCoreVal:=CoreValue;
    Result := SetProcessAffinityMask(hProc, iCoreVal);
    CloseHandle(hProc);
  end;
end;
und zu guter letzt die funktion GetProcessID:
Delphi-Quellcode:
uses Tlhelp32;

function GetProcessID(const aFileName: string): integer;
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
  aFile: string;
begin
  result:= 0;
  aFile:=ExtractFileName(aFileName);
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap = INVALID_HANDLE_VALUE then exit;
  pe32.dwSize := SizeOf(ProcessEntry32);
  if Process32First(hProcSnap, pe32) then
  begin
    while Process32Next(hProcSnap, pe32) do
    begin
      if lowerCase(pe32.szExeFile) = lowercase(aFile) then
      begin
        result:= pe32.th32ProcessID;
        break;
      end;
    end;
  end;
  CloseHandle(hProcSnap);
end;
ich denke mal das es auch eine andere methode gibt, aber da die funktion ja schon da war, dachte ich, warum soll ich die nicht ändern
hoffe du bist nicht böse, dass ich deinen code verändert habe.
bin gerne für änderungen und vorschläge offen, da ich nich relativ neu bin und mir deswegen leider öfter fehler unterlaufen
  Mit Zitat antworten Zitat
gitz

Registriert seit: 1. Feb 2011
1 Beiträge
 
#14

AW: Externe Exe starten und dieser einen best. Kern zuweisen

  Alt 1. Feb 2011, 21:22
Der Code hat einen kleinen fehler:

hier:
if iKernelNumb > lpSystemInfo.dwNumberOfProcessors

richtig:
if iKernelNumb > power(2,lpSystemInfo.dwNumberOfProcessors-1)

an anderer Stelle nochmals dasselbe.
ansonsten sehr nützlicher Code!
  Mit Zitat antworten Zitat
Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#15

AW: Externe Exe starten und dieser einen best. Kern zuweisen

  Alt 1. Feb 2011, 21:29
if iKernelNumb > power(2,lpSystemInfo.dwNumberOfProcessors-1)
kann man auch einfacher schreiben:
if iKernelNumb > 1 shl (lpSystemInfo.dwNumberOfProcessors-1)
  Mit Zitat antworten Zitat
Benutzerbild von Assarbad
Assarbad

Registriert seit: 8. Okt 2010
Ort: Frankfurt am Main
1.234 Beiträge
 
#16

AW: Externe Exe starten und dieser einen best. Kern zuweisen

  Alt 1. Feb 2011, 21:33
kann man auch einfacher schreiben:
if iKernelNumb > 1 shl (lpSystemInfo.dwNumberOfProcessors-1)
Einfacher ja, schneller vermutlich auch ... aber dann darf ein Kommentar nicht fehlen für all jene die sich nicht damit auskennen. Plus der Hinweis, daß es ab einer gewissen Anzahl Kerne nur noch 0 ergibt
Oliver
"... aber vertrauen Sie uns, die Physik stimmt." (Prof. Harald Lesch)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.166 Beiträge
 
Delphi 12 Athens
 
#17

AW: Externe Exe starten und dieser einen best. Kern zuweisen

  Alt 1. Feb 2011, 21:37
Dieses IF ist schon richtig so.
> Wenn der Kernel-Index größer als die Anzahl ist, dann auf den letzten Kern setzen.

Aber die nachfolgende Umrechnung von "Index" auf "Maske" fehlte.

Delphi-Quellcode:
if iKernelNumb > lpSystemInfo.dwNumberOfProcessors then
  iKernelNumb := lpSystemInfo.dwNumberOfProcessors;
if SetProcessAffinityMask(hProc, $1 shl (iKernelNumb - 1)) then
Wobei ich es etwas unpraktisch finde, daß man hier einen 1-basierenden Index verwendet.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 2     12   


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:41 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz