AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Beispiel für Verwendung von TMonitor.Wait / TMonitor.PulseAll
Thema durchsuchen
Ansicht
Themen-Optionen

Beispiel für Verwendung von TMonitor.Wait / TMonitor.PulseAll

Ein Thema von mjustin · begonnen am 15. Aug 2010
Antwort Antwort
mjustin

Registriert seit: 14. Apr 2008
3.006 Beiträge
 
Delphi 2009 Professional
 
#1

Beispiel für Verwendung von TMonitor.Wait / TMonitor.PulseAll

  Alt 15. Aug 2010, 12:15
Delphi-Version: 2009
Hallo,

heute hatte ich etwas Zeit und dieses Beispiel einer Producer/Consumer Anwendung auf Basis der neuen TMonitor Klasse geschrieben (s.a. What is TMonitor in Delphi System unit good for? auf Stackoverflow). Falls jemand darin verbesserungsfähigen Code findet (oder die ganze Lösung ganz anders angehen würde), freue ich mich sehr über Feedback. Dass die Synchronisation über die Drop Instanz erfolgt, ist der leichteren Lesbarkeit geschuldet - wer Why is lock(this) {…} bad? kennt, weiss was ich meine :)

Delphi-Quellcode:
program TMonitorTest;

// based on example code at http://download.oracle.com/javase/tutorial/essential/concurrency/guardmeth.html

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes;

type
  Drop = class(TObject)
  private
    // Message sent from producer to consumer.
    Msg: string;
    // True if consumer should wait for producer to send message, false
    // if producer should wait for consumer to retrieve message.
    Empty: Boolean;
  public
    constructor Create;
    function Take: string;
    procedure Put(AMessage: string);
  end;

  Producer = class(TThread)
  private
    FDrop: Drop;
  public
    constructor Create(ADrop: Drop);
    procedure Execute; override;
  end;

  Consumer = class(TThread)
  private
    FDrop: Drop;
  public
    constructor Create(ADrop: Drop);
    procedure Execute; override;
  end;

{ Drop }

constructor Drop.Create;
begin
  Empty := True;
end;

function Drop.Take: string;
begin
  TMonitor.Enter(Self);
  try
    // Wait until message is available.
    while Empty do
    begin
      TMonitor.Wait(Self, INFINITE);
    end;
    // Toggle status.
    Empty := True;
    // Notify producer that status has changed.
    TMonitor.PulseAll(Self);
    Result := Msg;
  finally
    TMonitor.Exit(Self);
  end;
end;

procedure Drop.Put(AMessage: string);
begin
  TMonitor.Enter(Self);
  try
    // Wait until message has been retrieved.
    while not Empty do
    begin
      TMonitor.Wait(Self, INFINITE);
    end;
    // Toggle status.
    Empty := False;
    // Store message.
    Msg := AMessage;
    // Notify consumer that status has changed.
    TMonitor.PulseAll(Self);
  finally
    TMonitor.Exit(Self);
  end;
end;

{ Producer }

constructor Producer.Create(ADrop: Drop);
begin
  FDrop := ADrop;
  inherited Create(False);
end;

procedure Producer.Execute;
var
  Msgs: array of string;
  I: Integer;
begin
  SetLength(Msgs, 4);
  Msgs[0] := 'Mares eat oats';
  Msgs[1] := 'Does eat oats';
  Msgs[2] := 'Little lambs eat ivy';
  Msgs[3] := 'A kid will eat ivy too';
  for I := 0 to Length(Msgs) - 1 do
  begin
    FDrop.Put(Msgs[I]);
    Sleep(Random(5000));
  end;
  FDrop.Put('DONE');
end;

{ Consumer }

constructor Consumer.Create(ADrop: Drop);
begin
  FDrop := ADrop;
  inherited Create(False);
end;

procedure Consumer.Execute;
var
  Msg: string;
begin
  repeat
    Msg := FDrop.Take;
    WriteLn('Received: ' + Msg);
    Sleep(Random(5000));
  until Msg = 'DONE';
end;

var
  ADrop: Drop;
begin
  Randomize;
  ADrop := Drop.Create;
  Producer.Create(ADrop);
  Consumer.Create(ADrop);
  ReadLn;
end.
Viele Grüße,
Michael Justin
Michael Justin
habarisoft.com
  Mit Zitat antworten Zitat
Antwort Antwort


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 07:44 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