Модуль myProcedure_unit.Pas:

unit myProcedure_unit;

interface

uses

sysutils, windows, messages, herd_unit;

var

WM_MYUSR1 : Cardinal;

WM_MYTERM : Cardinal;

WM_MYUSR2 : Cardinal;

{Вывод данных с переносом на следующую строку}

procedure myWriteLn(const Pformat: string; const Args: array of const);

{Вывод данных без переноса на следующую строку}

procedure myWrite(const Pformat: string; const Args: array of const);

{Вывод информации о процессах}

procedure myViewPrcs(const Max: integer);

{Вывод информации о приоритетах}

procedure myViewPrty;

{Регистрация сообщений в системе}

procedure regWinMes;

implementation

procedure myWriteLn(const Pformat: string; const Args: array of const);

var

mes : array [0..255] of char;

begin

chartooem(pchar(format(Pformat,Args)),mes);

writeln(mes);

end;

procedure myWrite(const Pformat: string; const Args: array of const);

var

mes : array [0..255] of char;

begin

chartooem(pchar(format(Pformat,Args)),mes);

write(mes);

end;

procedure myViewPrcs(const Max: integer);

var

i : integer;

begin

myWriteLn('Процесс Параметр первого этапа Параметр второго этапа',[]);

for i:=1 to Max do begin

myWriteLn('%7d%25d%25d'

,[ee[i].no,ee[i].a1waitI,ee[i].a0waitI]);

end; {for}

end;

procedure myViewPrty;

begin

mywriteln('№ Приоритет',[]);

mywriteln('0 низкий.',[]);

mywriteln('1 ниже среднего.',[]);

mywriteln('2 нормальный.',[]);

mywriteln('3 выше среднего.',[]);

mywriteln('4 высокий.',[]);

mywriteln('5 реального времени.',[]);

end;

procedure regWinMes;

begin

WM_MYUSR1:=RegisterWindowMessage('WM_MYUSR1');

WM_MYTERM:=RegisterWindowMessage('WM_MYTERM');

WM_MYUSR2:=RegisterWindowMessage('WM_MYUSR2');

end;

end.

************************************************************************

processPr.dpr:

(***************************************************************************)

(* Дочерний процесс *)

(***************************************************************************)

program processPr;

{$APPTYPE CONSOLE}

uses

sysutils, windows, messages, process_unit, a0wait_unit,

a1wait_unit, curtime_unit, myProcedure_unit;

var

this : processRec; // параметры процесса

thisState : integer; // состояние

prty : string; // текущий приоритет

Msg: TMsg; // сообщения системы

ID, ThrHandle: Cardinal; // дескриптор (handle) - ThrHandle и идентификатор потока - ID

monPrcThID : Cardinal; // идентификатор потока монитора

procedure Execute; // процедура - тело потока

begin // цикл обработки сообщений

while GetMessage(Msg,0,0,0) do begin // берем сообщение в переменную Msg

if (msg.message=WM_MYUSR1) then begin // обработка сообщения WM_MYUSR1

if (thisState=0) then begin // при невыполненном первом этапе

PostThreadMessage(monPrcThID,WM_MYUSR1,this.no,0);

end

else begin // при выполненном первом этапе

PostThreadMessage(monPrcThID,WM_MYUSR2,this.no,0);

end; {if}

end

else if (msg.message=WM_MYTERM) then begin // обработка сообщения WM_MYTERM

waitFactor:=abs((gettickcount-waitFactor)-iGl);

mywriteln('%s - Процесс %2d - принял сообщение WM_MYTERM.'

,[curtime,this.no]);

mywriteln('%s - Процесс %2d - фактор ожидания = %d.'

,[curtime,this.no,waitFactor]);

if (thisState=0) or (waitFactor>1000) then begin

mywriteln('%s - Процесс %2d - завершен принудительно.'

,[curtime,this.no]);

halt(0); // прерываем процесс

end

else begin // при выполненном первом этапе и если waitFactor<=1000

mywriteln('%s - Процесс %2d - получил отсрочку.'

,[curtime,this.no]);

end; {if}

end; {if}

sleep(0);

end; {while}

end;

begin

this.no:=strtoint(paramstr(1)); //

this.a1waitI:=strtoint(paramstr(2)); // прием параметров

this.a0waitI:=strtoint(paramstr(3)); //

monPrcThID:=strtoint(paramstr(4)); //

regWinMes; // регистрация пользовательских сообщений

ThrHandle:=CreateThread(nil,0,@Execute,nil,0,ID); // создаем новый поток

{Sleep(0) Приведет к немедленному досрочному завершение

кванта процессорного времени, выделенного

дополнительному потоку, и передаче управления

основному потоку (если только он имеет тот же приоритет).}

sleep(0);

PostThreadMessage(monPrcThID,WM_USER,this.no,ID); // отправляем сообщение потоку монитора

randomize; // инициализация генератора случайных чисел

thisState:=0; // состояние = 0;

case GetPriorityClass(GetCurrentProcess) of

$40 : prty:='низкий';

$4000 : prty:='ниже среднего';

$20 : prty:='нормальный';

$8000 : prty:='выше среднего';

$80 : prty:='высокий';

$100 : prty:='реального времени';

end;

// сообщение о начале

mywriteln('%s - Процесс %2d - запущен, приоритет - %s.'

,[curtime,this.no,prty]);

// сообщение о начале первого этапа

mywriteln('%s - Процесс %2d - выполнение первого этапа (параметр %d)...'

,[curtime,this.no,this.a1waitI]);

// время задержки - случайная величина, зависащая от a1waitI

a1wait(this.a1waitI);

thisState:=1; // после первого этапа состояние = 1

// сообщение об окончании первого этапа

mywriteln('%s - Процесс %2d - первый этап выполнен.'

,[curtime,this.no]);

// сообщение о начале второго этапа

mywriteln('%s - Процесс %2d - выполнение второго этапа (параметр %d)...'

,[curtime,this.no,this.a0waitI]);

// время задержки, с фиксированным интрервалом от 1 до a0waitI

a0wait(this.a0waitI);

// сообщение об окончании второго этапа

mywriteln('%s - Процесс %2d - второй этап выполнен.'

,[curtime,this.no]);

end.

processCrt.dpr:

(***************************************************************************)

(* МОНИТОР ПРОЦЕССОВ *)

(***************************************************************************)

program processCrt;

{$APPTYPE CONSOLE}

uses

windows, sysutils, messages, process_unit,

herd_unit, curtime_unit, myProcedure_unit;

(* Структура, описывающая процесс:

содержит параметры процесса и упавляющую информацию о нем *)

type

proc = record

pr : ^processRec; // указатель на параметры

inf : Tprocessinformation; // информация о процессе

prty : Dword; // приоритет процесса

status : Integer; // состояние процесса

end;

const

CHLD_NAME : string = 'processPr';

CRFLAGS : Dword = CREATE_UNICODE_ENVIRONMENT;

NEW_CONSOLE_TITLE = 'Process Monitor';

MAX_PRTY = 2;

var

i : Integer; // параметр циклов

prcs : array [1..NE] of proc; // управляющая информация о процессе

cnt : Integer = 0; // число запущенных процессов

stat : Cardinal; // состояние процесса при завершении

procinfo : TProcessinformation; // идентификатор процесса

startinfo : Tstartupinfo;

mes : array [0..255] of char; // сообщения программы

timeWait : integer = 2500; // время ожидания в ms.

maxPrcs : integer = NE; // количество процессов

noPrcs : integer; // номер обрабатываемого процесса

myPrty : integer; // приоритет обрабатываемого процесса

myPrtyT : integer;

Msg : TMsg; // сообщения системы

ID, ThrHandle: Cardinal; // дескриптор (handle) - ThrHandle и идентификатор потока - ID

prcThID : array [1..NE] of Cardinal; // идентификатор потока процесса

procedure MonExecute; // процедура - тело потока

begin // цикл обработки сообщений

while GetMessage(Msg,0,0,0) do begin // берем сообщение в переменную Msg

if (msg.message=WM_USER) then begin // обработка сообщения WM_USER

prcThID[msg.wParam]:=msg.lParam; // определение идентификатора потока процесса

end

else if (msg.message=WM_MYUSR1) then begin // обработка сообщения WM_MYUSR1

prcs[msg.wParam].status:=1;

terminateprocess(prcs[msg.wParam].inf.hProcess,0); // прерываем процесс

mywriteln('%s - Процесс %2d - завершен принудительно.' // сообщение о прерывании процесса

,[curtime,msg.wParam])

end

else if (msg.message=WM_MYUSR2) then begin // обработка сообщения WM_MYUSR2

prcs[msg.wParam].status:=2;

PostThreadMessage(prcThID[msg.wParam],WM_MYTERM,0,0); // отправляем сообщение потоку процесса

end; {if}

sleep(0);

end; {while}

end;

begin

SetConsoleTitle(NEW_CONSOLE_TITLE); // изменяем заголовок консоли

randomize; // инициализация генератора случайных чисел

mywriteln('%s - МОНИТОР ПРОЦЕССОВ.',[curtime]);

mywriteln('-*******************************-',[]);

mywriteln('%s - НАЧАЛО РАБОТЫ.',[curtime]);

writeln;

mywrite('Введите количество процессов (не больше %d): ',[NE]);

readln(maxPrcs);

if (maxPrcs>NE) then

maxPrcs:=NE

else if (maxPrcs<1) then

maxPrcs:=1;

myViewPrcs(maxPrcs); // вывод информации о процессах

writeln;

{Изменение параметров обрабатываемого процесса}

mywrite('Введите номер наблюдаемого процесса '

+'(если наблюдение не нужно, то любое число не из таблицы): ',[]);

readln(noPrcs);

if (noPrcs<=maxPrcs) and (noPrcs>=1) then begin

writeln;

mywriteln('Ввод параметров для %d процесса:',[ee[noPrcs].no]);

mywrite('Введите параметр первого этапа (по умолчанию %d): '

,[ee[noPrcs].a1waitI]);

readln(ee[noPrcs].a1waitI);

if (ee[noPrcs].a1waitI<1) then ee[noPrcs].a1waitI:=1;

mywrite('Введите параметр второго этапа (по умолчанию %d): '

,[ee[noPrcs].a0waitI]);

readln(ee[noPrcs].a0waitI);

if (ee[noPrcs].a0waitI<1) then ee[noPrcs].a1waitI:=1;

myViewPrty; // вывод возможных приоритетов

writeln;

mywrite('Введите № приоритета: ',[]);

readln(myPrty);

if (myPrty<0) or (myPrty>5) then myPrty:=2;

end; {if}

writeln;

mywrite('Введите время ожидания (в с.): ',[]);

readln(timeWait);

writeln;

regWinMes; // регистрация пользовательских сообщений

ThrHandle:=CreateThread(nil,0,@MonExecute,nil,0,ID); // создаем новый поток

{Sleep(0) Приведет к немедленному досрочному завершение

кванта процессорного времени, выделенного

дополнительному потоку, и передаче управления

основному потоку (если только он имеет тот же приоритет).}

sleep(0);

timeWait:=timeWait*1000;

startinfo.cb:=sizeof(startinfo);

for i:=1 to maxPrcs do begin // цикл по массиву процессов

prcs[i].pr:=@ee[i]; // запись параметров в упраляющую информацию

if (i=noPrcs) then begin

myPrtyT:=myPrty; // выбранный приоритет обрабатываемого процесса

end

else begin

myPrtyT:=random(MAX_PRTY); // случайный выбор приоритета

end; {if}

case myPrtyT of

0: prcs[i].prty:=$40; // приоритет низкий

1: prcs[i].prty:=$4000; // приоритет ниже среднего

2: prcs[i].prty:=$20; // приоритет нормальный

3: prcs[i].prty:=$8000; // приоритет выше среднего

4: prcs[i].prty:=$80; // приоритет высокий

5: prcs[i].prty:=$100; // приоритет реального времени

end; {case}

prcs[i].status:=-1; // состояние процесса - пока он не запущен

// порождение процесса

if createprocess(nil,pchar(format('%s %d %d %d %d',[chld_name,prcs[i].pr^.no

,prcs[i].pr^.a1waitI,prcs[i].pr^.a0waitI,ID])),nil,nil,false

,(crflags or prcs[i].prty),nil,nil,startinfo

,prcs[i].inf)// передача параметров

then begin

prcs[i].status:=0; // состояние процесса - запущен

inc(cnt); // подсчет запущенных процессов

end

else begin

writeln;

mywriteln('ОШИБКА ЗАПУСКА %2d ПРОЦЕССА № %d.'

,[prcs[i].pr^.no,getlasterror]);

writeln;

end; {if}

end; {for}

if cnt=0 then halt(0); // если запущенных процессов = 0 => завершение

sleep(timeWait); // пауза монитора, процессы в это время выполняются

writeln;

mywriteln('%s - ВРЕМЯ ОЖИДАНИЯ (%g с.) ИСТЕКЛО.',[curtime,timeWait/1000]);

writeln;

for i:=1 to maxPrcs do begin // перебор всех запущенных процессов

// если состояние процесса "не запущен", он не проверяется

if prcs[i].status<0 then continue;

// проверка завершения процесса

GetExitCodeProcess(prcs[i].inf.hProcess,stat);

// если процесс завершился => сообщение о его успешном завершении

if stat <> STILL_ACTIVE then begin

mywriteln('%s - Процесс %2d - нормально завершился.',[curtime,prcs[i].pr^.no]);

end

else begin

PostThreadMessage(prcThID[i],WM_MYUSR1,0,0); // отправляем сообщение потоку процесса

sleep(0);

end; {if}

end; {for}

readln;

end.