1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
| //Poses un mémo et un bouton sur la fiche.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls;
type
TTestThread = class(TThread)
StartEvent :THandle;
ReadyEvent :THandle;
Interval :integer;
public
procedure Execute; override;
constructor Create(aStartEvent, aReadyEvent :THandle);
end;
TForm1 = class(TForm)
// Button1: TButton;
// Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
ThreadList :array of TTestThread; //Liste des Threads (processeurs)
StartList :array of THandle; //Liste des Events (Démarrage)
ReadyList :array of THandle; //Liste des Events (Prêt)
end;
var
Form1: TForm1;
const
NbProcessor :dword = 4; //Nombre de processeurs
implementation
{$R *.dfm}
{ TTestThread }
constructor TTestThread.Create(aStartEvent, aReadyEvent :THandle);
begin
inherited Create(FALSE);
StartEvent := aStartEvent;
ReadyEvent := aReadyEvent;
Interval := Random(3000); //Pour simuler la durée de la tâche (max 3s)
end;
procedure TTestThread.Execute;
begin
while not Terminated do
//Attente du démarrage
if WaitForSingleObject(StartEvent, 0) <> WAIT_TIMEOUT then
begin
ResetEvent(StartEvent); //Démarré
Sleep(Interval); //Calculation en cours (simulation)...
SetEvent(ReadyEvent); //Terminé, prêt à recevoir une nouvelle commande
end;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
NbTask :Integer;
WaitState :dword;
ID :integer;
t :integer;
begin
NbTask := 100; //Le nombre de simulation
while NbTask > 0 do
begin
//Attend qu'un Thread soit libre (Test sur tous les Events)
WaitState := WaitForMultipleObjects(NbProcessor, @ReadyList[0], FALSE, 10000);
if WaitState = WAIT_TIMEOUT then
Raise Exception.Create('Time-out')
else
begin
ID := WaitState -WAIT_OBJECT_0; //Index Thread disponible
//PREPARATION NOUVEAU TRAITEMENT
Memo1.Lines.Add(Format('%s Processeur: %d, Tâche: %d, Durée: %.2fs', [FormatDateTime('hh:nn:ss', Now), WaitState -WAIT_OBJECT_0, NbTask, ThreadList[ID].Interval /1000]));
//FIN PREPARATION
ResetEvent(ReadyList[ID]); //Défini le Thread comme occupée...
SetEvent(StartList[ID]); //...et le démarre
Dec(NbTask); //Une tâche de moins
end;
end;
//Attend la fin de toutes les tâches
Memo1.Lines.Add('Toutes les tâches assignées. Attend la fin...');
WaitForMultipleObjects(NbProcessor, @ReadyList[0], TRUE, INFINITE);
Memo1.Lines.Add('Terminé!');
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
//Un Thread par processeur
SetLength(ThreadList, NbProcessor);
//Un Event par processeur
SetLength(StartList, NbProcessor);
SetLength(ReadyList, NbProcessor);
//Création des Threads et Events
for i := 0 to NbProcessor -1 do
begin
StartList[i] := CreateEvent(nil, TRUE, FALSE, PChar(Format('Processor%d_Start', [i])));
ReadyList[i] := CreateEvent(nil, TRUE, TRUE, PChar(Format('Processor%d_Stop', [i])));
ThreadList[i] := TTestThread.Create(StartList[i], ReadyList[i]);
ThreadList[i].Priority := tpIDLE;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
i: Integer;
begin
//Libération des Threads
for i := 0 to High(ThreadList) do
ThreadList[i].Free;
end;
initialization
Randomize;
end. |
Partager