Hallo Gemeinde,

ich habe gerade ein Brett vor dem Kopf und das Gefühl etwas ganz Wesentliches in Bezug auf Threads und Events nicht verstanden zu haben.

Wenn mich jemand in die richtige Richtung schubsen würde, wäre ich sehr dankbar.

Was habe ich vor?

Eine Anwendung soll aus einer DLL über ein COM-Interface-Objekt als Wrapper einen Thread starten.
Beim Instanziieren des COM-Interface-Objekts aus der DLL wird der Thread suspendiert erzeugt.

Dieser Thread soll nach dem Starten beim Ausführen ein Messgerät ständig abfragen bzw. pollen und zwar so schnell wie möglich (oder wie es die Hardware zulässt).

Die Host-Anwendung lässt sich super beenden, wenn der Thread gestartet wurde und sein Execute durchläuft.
Wenn ich aber das Programm beenden will, ohne das der Thread losläuft, dann hänge ich im System.Classes.TThread.Destroy fest.
Es wird die folgende While-Schleife nie verlassen:

zusammenfalten · markieren

Delphi-Quellcode:

destructor TThread.Destroy;
begin
  if (FThreadID <> 0) and not FFinished and not FExternalThread then
  begin
    Terminate;
    if FCreateSuspended or FSuspended then
      Resume;
...
    while not FStarted do
...
      Yield; // Hier komme ich nicht raus!
    WaitFor;
  end;
...
end;

Mit der folgenden Testanwendung (auch als gezipptes XE7-Projekt im Anhang) wird mein Problem nachvollziehbar.
Das COM-Interface-Objekt wird im AfterConstruction des Hauptformulars erzeugt und erzeugt dann wiederrum intern den Thread.
Wenn die Anwendung beendet wird, ohne auf den Button geklickt zu haben, bleibt das Programm im Taskmanager mit Endlosschleife stehen.

Was mache ich falsch?
Muss ich das Problem ganz anderes angehen?
Ich bitte um Rat!

zusammenfalten · markieren

Delphi-Quellcode:

unit Main.View;

interface

uses
  System.SysUtils,
  System.Classes,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.StdCtrls;

type
  IDataManager = interface
    ['{936641B4-4868-4EFB-8513-65FE4DF51397}']
    procedure StartDataGrapping; stdcall;
  end;

  TForm2 = class(TForm)
    btnStartDataGrapping : TButton;
    procedure btnStartDataGrappingClick(Sender : TObject);
  private
    FDataManager : IDataManager;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

const
  THREAD_PROBLEM_DLL = 'ThreadProblemDLL.dll';

function GetDataManager(out DataManager : IDataManager) : ByteBool; stdcall; external THREAD_PROBLEM_DLL;

var
  Form2 : TForm2;

implementation

{$R *.dfm}


procedure TForm2.AfterConstruction;
begin
  inherited;
  GetDataManager(FDataManager);
end;

procedure TForm2.BeforeDestruction;
begin
  inherited;
end;

procedure TForm2.btnStartDataGrappingClick(Sender : TObject);
begin
  if Assigned(FDataManager) then
  begin
    FDataManager.StartDataGrapping;
  end;
end;

end.

zusammenfalten · markieren

Delphi-Quellcode:

unit DLL.DataManager;

interface

uses
  System.SysUtils,
  System.Classes,
  DLL.Thread;

type
  IDataManager = interface
    ['{936641B4-4868-4EFB-8513-65FE4DF51397}']
    procedure StartDataGrapping; stdcall;
  end;

  TDataManager = class(TInterfacedObject, IDataManager)
  strict private
    FMyThread : TMyThread;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;

    procedure StartDataGrapping; stdcall;
  end;

function GetDataManager(out DataManager : IDataManager) : ByteBool; stdcall;

implementation

var
  _DataManager : IDataManager;

function GetDataManager(out DataManager : IDataManager) : ByteBool; stdcall;
begin
  if not Assigned(_DataManager) then
  begin
    _DataManager := TDataManager.Create;
  end;
  DataManager := _DataManager;
  Result := Assigned(DataManager);
end;

procedure TDataManager.AfterConstruction;
begin
  inherited;
  FMyThread := TMyThread.Create(True);
end;

procedure TDataManager.BeforeDestruction;
begin
  inherited;
  FMyThread.Free;
end;

procedure TDataManager.StartDataGrapping;
begin
  if Assigned(FMyThread) then
  begin
    if not FMyThread.Started then
    begin
      FMyThread.Start;
    end;
  end;
end;

end.

zusammenfalten · markieren

Delphi-Quellcode:

unit DLL.Thread;

interface

uses
  System.SysUtils,
  System.Classes,
  Winapi.Windows,
  System.SyncObjs;

type
  TLock = System.SyncObjs.TCriticalSection;

  TBaseThread = class(TThread)
  private
    FThreadName : string;
  protected
    FLock : TLock;
    FWaitEvent : TEvent;

    procedure Execute; override;
    procedure ProcessInternalTask; virtual; abstract;
    procedure TerminatedSet; override;
  public
    procedure LogToOutput(const Text : string);
    constructor Create(CreateSuspended : Boolean = True); overload;
    destructor Destroy; override;
  end;

  TMyThread = class(TBaseThread)
  strict private
    FData : UInt64;
  protected
    procedure ProcessInternalTask; override;
  end;

implementation

constructor TBaseThread.Create(CreateSuspended : Boolean = True);
begin
  inherited Create(CreateSuspended);
  FLock := TLock.Create;
  FWaitEvent := TEvent.Create;
  FThreadName := Self.ClassName + '-' + Self.ThreadID.ToString;
  NameThreadForDebugging(FThreadName, ThreadID);
end;

destructor TBaseThread.Destroy;
begin
  inherited;
  FWaitEvent.Free;
  FLock.Free;
end;

procedure TBaseThread.Execute;
begin
  inherited;
  while not Terminated do
  begin
    FWaitEvent.WaitFor(1);
    if not Terminated then
    begin
      ProcessInternalTask;
    end;
  end;
end;

procedure TBaseThread.LogToOutput(const Text : string);
begin
  OutputDebugString(PWideChar(Text));
end;

procedure TBaseThread.TerminatedSet;
begin
  inherited;
  FWaitEvent.SetEvent;
end;

procedure TMyThread.ProcessInternalTask;
begin
  try
    Inc(FData);
    if (FData mod 1000) = 0 then
      LogToOutput('FData say Hello! ' + FData.ToString);
  except
    on E : Exception do
      LogToOutput(E.ClassName + ': ' + E.Message);
  end;
end;

end.

Ich habe einmal folgendes getan:

1. Dem IDataManager einmal eine Methode Dispose() hinzugefügt
2. Sie in TDataManager mit FreeAndNil(FMyThread) gefüllt
3. Im Destruktor der MainForm einmal FDataManager.Dispose() gesagt.

Dann bekommt er es hin, den schlafenden Thread zu resumen damit dieser sich dann beenden kann. Warum das so ist habe ich allerdings auch noch nicht verstanden.

Ich sehe nur, dass TThread.Resume ResumeThread aus der WinApi aufruft und eben dieser Aufruf in "deinem" Fall 0 und in "meinem" 1 zurückgibt. Komisch.

Edit:
Ich sehe auch grade, der Aufrufstack der Dispose-Methode und des Destruktors deines TDataManager ist ein völlig anderer. Wahrscheinlich liegt das an der globalen Variable dass deren RefCount erst ziemlich spät auf Null fällt und zu dem Zeitpunkt hat die Host-Anwendung in ihrem Shutdown wahrscheinlich schon so komische Dinge gedreht dass man keine Threads mehr fortsetzen kann.

PPS: Ja, das scheint es zu sein.

Zitat von Der schöne Günther:

Wahrscheinlich liegt das an der globalen Variable dass deren RefCount erst ziemlich spät auf Null fällt und zu dem Zeitpunkt hat die Host-Anwendung in ihrem Shutdown wahrscheinlich schon so komische Dinge gedreht dass man keine Threads mehr fortsetzen kann.

Globale Interface-Variablen sind m.E. ein No-Go. Mal unabhängig davon, daß globale Variablen an sich schon bedenklich sind.

Ja. Ich würde mir einen Zähler einbauen und sagen "mehr als 100 Instanzen erlaube ich nicht". Falls das gewünscht ist. Mit so etwas läuft das Programm dann auch wie gewünscht.

Zitat von Uwe Raabe:

Zitat von Der schöne Günther:

Wahrscheinlich liegt das an der globalen Variable dass deren RefCount erst ziemlich spät auf Null fällt und zu dem Zeitpunkt hat die Host-Anwendung in ihrem Shutdown wahrscheinlich schon so komische Dinge gedreht dass man keine Threads mehr fortsetzen kann.

Globale Interface-Variablen sind m.E. ein No-Go. Mal unabhängig davon, daß globale Variablen an sich schon bedenklich sind.

Daran habe ich gar nicht gedacht!
Meine Vermutung war, dass ich irgendetwas mit dem Event verkehrt gemacht habe.
Wenn ich die Factory-Funktion so umändere, dass die einzig lebende Instanz dann nur im Hauptformular existiert, dann geht es!
Vielen Dank!

zusammenfalten · markieren

Delphi-Quellcode:

implementation

//var
// _DataManager : IDataManager;

function GetDataManager(out DataManager : IDataManager) : ByteBool; stdcall;
begin
// if not Assigned(_DataManager) then
// begin
// _DataManager := TDataManager.Create;
// end;
// DataManager := _DataManager;

  DataManager := TDataManager.Create;
  Result := Assigned(DataManager);
end;

Ich hatte mir das ein bisschen von VCL.Direct2D abgeschaut.
Das scheint aber ein bisschen anderes zu funktionieren, verstehe den Trick mit dem InterlockedCompareExchangePointer noch nicht so ganz.

zusammenfalten · markieren

Delphi-Quellcode:

unit Vcl.Direct2D;
...
implementation
...
{ Singleton objects }

var
  SingletonD2DFactory: ID2D1Factory;

  function D2DFactory(factoryType: TD2D1FactoryType=D2D1_FACTORY_TYPE_SINGLE_THREADED;
  factoryOptions: PD2D1FactoryOptions=nil): ID2D1Factory;
var
  LD2DFactory: ID2D1Factory;
begin
  if SingletonD2DFactory = nil then
  begin
  D2D1CreateFactory(factoryType, IID_ID2D1Factory, factoryOptions, LD2DFactory);
  if InterlockedCompareExchangePointer(Pointer(SingletonD2DFactory), Pointer(LD2DFactory), nil) = nil then
    LD2DFactory._AddRef;
  end;
  Result := SingletonD2DFactory;
end;

Wäre die Situation aus Clean Code Sicht eigentlich okay, wenn ich derartige Variablen als strict private class var deklariere oder ist das auch schon grenzwertig und nur verschlimmbesserte globale Variablen?

Ich verstehe nicht, warum du dir deine Instanz überhaupt in der Dll merken willst. Wozu? Soll es nur eine (eine bestimmte Anzahl) gleichzeitig geben können? Dann mach doch einen Zähler.
Willst du ein Singleton? Dann merke es dir doch als Klassentyp (TDataManager), denn du weißt ja in der Dll die konkrete Klasse.