Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#6

AW: Threads anhalten und fortsetzen

  Alt 25. Jun 2015, 12:06
Hier mal ein kleiner Worker-Thread (ohne viel Gedöns), den man auch schlafen legen kann.
Delphi-Quellcode:
unit Unit2;

interface

uses
  Classes, SyncObjs, SysUtils, Generics.Collections;

type
  TWorkerThread = class( TThread )
  private
    FLockObj: TObject;
    FIsSleeping: Boolean;
    FWorkEvent: TEvent;
    FWorkQueue: TQueue<TProc>;
  protected
    procedure Execute; override;
    procedure TerminatedSet; override;
  public
    constructor Create( CreateSuspended: Boolean );
    destructor Destroy; override;

    /// <summary>
    /// Arbeit an die WorkerThread-Queue übergeben
    /// </summary>
    procedure PushWork( AWorkProc: TProc );

    /// <summary>
    /// WorkerThread schlafen legen
    /// </summary>
    procedure GoSleeping( );
    /// <summary>
    /// WorkerThread wieder aufwecken
    /// </summary>
    procedure Awake( );
  end;

implementation

{ TWorkerThread }

procedure TWorkerThread.Awake;
begin
  TMonitor.Enter( FLockObj );
  try
    FIsSleeping := False;
    if FWorkQueue.Count > 0 then
      FWorkEvent.SetEvent( );
  finally
    TMonitor.Exit( FLockObj );
  end;
end;

constructor TWorkerThread.Create( CreateSuspended: Boolean );
begin
  FLockObj := TObject.Create( );
  FWorkEvent := TEvent.Create( nil, True, False, '' );
  FWorkQueue := TQueue<TProc>.Create( );

  inherited;
end;

destructor TWorkerThread.Destroy;
begin
  inherited;

  FreeAndNil( FLockObj );
  FreeAndNil( FWorkQueue );
  FreeAndNil( FWorkEvent );
end;

procedure TWorkerThread.Execute;
var
  LWorkProc: TProc;
begin
  inherited;
  while not Terminated do
  begin
    if ( FWorkEvent.WaitFor( ) = wrSignaled ) then
      if not Terminated then
      begin

        // Arbeit aus der Queue holen

        TMonitor.Enter( FLockObj );
        try
          LWorkProc := FWorkQueue.Dequeue( );
          if FWorkQueue.Count = 0 then
            FWorkEvent.ResetEvent( );
        finally
          TMonitor.Exit( FLockObj );
        end;

        // Arbeit erledigen

        LWorkProc( );
      end;
  end;
end;

procedure TWorkerThread.GoSleeping;
begin
  TMonitor.Enter( FLockObj );
  try
    FIsSleeping := True;
    FWorkEvent.ResetEvent( );
  finally
    TMonitor.Exit( FLockObj );
  end;
end;

procedure TWorkerThread.PushWork( AWorkProc: TProc );
begin
  TMonitor.Enter( FLockObj );
  try
    FWorkQueue.Enqueue( AWorkProc );
    if not FIsSleeping then
      FWorkEvent.SetEvent( );
  finally
    TMonitor.Exit( FLockObj );
  end;
end;

procedure TWorkerThread.TerminatedSet;
begin
  inherited;
  FWorkEvent.SetEvent( );
end;

end.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat