Sætte lav prioritet på et program

En kode jeg fandt.
Men den kan ikke gøre det på ANDRE programmer, kun på sig selv.

unit Priority_Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TfrmPriority = class(TForm)
    fraPriority: TGroupBox;
    cmbPriority: TComboBox;
    lblCurrentPriority: TLabel;
    cmdSetPriority: TButton;
    cmdExit: TButton;
    lblPriority: TLabel;
    procedure cmdExitClick(Sender: TObject);
    procedure cmdSetPriorityClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
    frmPriority: TfrmPriority;  //Form variable
    g_TimerID: Cardinal;        //Handle to the timer
const
    {Declare constants for below
    and above normal priorities}
    BELOWNORMAL_PRIORITY_CLASS = $4000;
    ABOVENORMAL_PRIORITY_CLASS = $8000;
    //Declare the timer delay (in milliseconds)
    TimerDelay = 100;
implementation

{$R *.dfm}

procedure TfrmPriority.cmdExitClick(Sender: TObject);
begin
    //Disable the timer
    KillTimer(Application.Handle, g_TimerID);
    //Terminate the application
    Application.Terminate
end;

procedure TfrmPriority.cmdSetPriorityClick(Sender: TObject);
var
    NewPriority: Integer;  //Variable to hold new priority value
    pID: Integer;          //Handle to the current process
    RetVal: Boolean;        //Return value from SetPriorityClass
begin
    NewPriority := -1;      //Initialize the new priority
    //Determine the new priority
    case cmbPriority.ItemIndex of
        0: NewPriority := IDLE_PRIORITY_CLASS;
        1: NewPriority := BELOWNORMAL_PRIORITY_CLASS;
        2: NewPriority := NORMAL_PRIORITY_CLASS;
        3: NewPriority := ABOVENORMAL_PRIORITY_CLASS;
        4: NewPriority := HIGH_PRIORITY_CLASS;
        5: NewPriority := REALTIME_PRIORITY_CLASS;
    end;
    //Get a handle to our process
    pID := OpenProcess(PROCESS_ALL_ACCESS, False, GetCurrentProcessID);
    //Set the new priority
    RetVal := SetPriorityClass(pID, NewPriority);
    //Close the process handle
    CloseHandle(pID);
    //Check if we succeeded
    if RetVal then
        //Priority changed successfully
        MessageBox(0, 'Priority changed', 'Success', MB_ICONINFORMATION)
    else
        //Error changing priority
        MessageBox(0, 'Error changing priority', 'Error', MB_ICONHAND);
    ;
end;

procedure TimerCallBack();  //Callback for the timer
var
    pID: Integer;          //Handle to the current process
    PriorityClass: Integer; //Return value for GetPriorityClass
    ResultString: String;  //Return string derived from GetPriorityClass return value
begin
    {Disable the timer to prevent reentrancy while
    processing, just in case MessageBox is called}
    KillTimer(Application.Handle, g_TimerID);
    //Get a handle to our process
    pID := OpenProcess(PROCESS_ALL_ACCESS, False, GetCurrentProcessID);
    //Get the priority of our process
    PriorityClass := GetPriorityClass(pID);
    //Close the process handle
    CloseHandle(pID);
    //Determine priority of our process
    case PriorityClass of
        0:                      ResultString := 'Error Retrieving Priority';
        IDLE_PRIORITY_CLASS:    ResultString := 'IDLE_PRIORITY_CLASS';
        BELOWNORMAL_PRIORITY_CLASS: ResultString := 'BELOWNORMAL_PRIORITY_CLASS';
        NORMAL_PRIORITY_CLASS:  ResultString := 'NORMAL_PRIORITY_CLASS';
        ABOVENORMAL_PRIORITY_CLASS: ResultString := 'ABOVENORMAL_PRIORITY_CLASS';
        HIGH_PRIORITY_CLASS:    ResultString := 'HIGH_PRIORITY_CLASS';
        REALTIME_PRIORITY_CLASS:ResultString := 'REALTIME_PRIORITY_CLASS';
    else
        {If an unknown result occurs from
        GetPriorityClass, handle it here}
        MessageBox(0, PChar('Unknown Priority Level: ' + IntToStr(PriorityClass)), 'Unknown Priority', MB_ICONEXCLAMATION);
    end;
    //Update the caption on the form
    frmPriority.lblPriority.Caption := ResultString;
    {Reenable the timer to catch further
    changes to the process priority}
    g_TimerID := SetTimer(Application.Handle, 0, TimerDelay, Addr(TimerCallBack));
end;

procedure TfrmPriority.FormCreate(Sender: TObject);
begin
    //Initialize the timer
    g_TimerID := SetTimer(0, 0, TimerDelay, Addr(TimerCallback));
end;

end.

ellers kan du download det tilhørende program her:

http://www.1delphistreet.com/vb/scripts/ShowZip.asp?lngWId=7&lngCodeId=785&strZipAccessCode=tp%2FP7855039

linket er lidt langsomt, men den kommer.

Dette stykke kode gør at dit program's prioritet bliver sat på LOW

SetPriorityClass(GetCurrentProcess, IDLE_PRIORITY_CLASS);


Det kan du evt. sætte til en knap eller lign.

Men ellers kan du jo kigge denne her side igennem...

Der står en masse links til noget med Priority i Delphi

http://xdds.nepro.net/~cho/3kdt/index.php?bgcolor=%23EED24F&keyval=priority&op=and

Hvis du laver et svar får du point.

Mange tak,

Rune

svar

ups...

hehe her er et svar.

Skal du ikke lukke?

Jo men det virker ikke

virker det ikke hvis du bare trykker accepter?

Nej, det virker ikke. Jeg ved ikke om det min browser setting der er forkert. Det har virket for mig før.

hmm, spøjst.