27. maj 2004 - 22:16
Der er
11 kommentarer og
2 løsninger
Sætte lav prioritet på et program
Hej,
Jeg vil lave et program som sender pakker ud til andre små programmer. Disse små programmer skal starte op så at de har lav prioritet så de forstyr brugen så lidt som muligt.
Er der nogen der ved hvordan man sætter et programs prioritet?
Er der nogen der har erfaring med noget lignende?
Mvh,
Rune
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.
