mehrere Threads sauber beenden

[haentschman]

Die Threads stehen sowieso und tun nix... Die Klasse1 ist nicht der Thread. Klasse1 erzeugt die Threads. Im Destroy der Klasse1 sollen die Threads aufgeräumt werden. Das Sleep(200) sollte imho dazu da sein, daß´die Threads Zeit haben zu reagieren. Aber die bewegen sich ja nicht.
Laut Status der Threads in der Objektliste: Suspended = False sollten sie das aber nicht.

die ThreadUnit Komplett(entspricht Klasse2 des Übersichtsbeispieles):

Delphi-Quellcode:

unit XWebLoader;

interface

uses Classes, SysUtils, SyncObjs, IdHTTP, IdComponent, XWebDataTypes;

type

  TOnFinishLoadEvent = procedure(Sender: TObject; LoaderMessage: TXWebLoaderMessage) of object;
  TOnErrorLoadEvent = procedure(Sender: TObject; LoaderMessage: TXWebLoaderMessage) of object;
  TOnRemoveEvent = procedure(Sender: TObject) of object;

  TXWebLoader = class(TThread)
  strict private
   FCS: TCriticalSection;
   FHTTP: TIdHTTP;
   FXWebLink: string;
   FParameter: string;
   FCookie: string;
   FDeviceName: string;
   FMessageID: Integer;
   FDigit: Integer;
   FGoLoading: Boolean;
   FOnFinish: TOnFinishLoadEvent;
   FOnError: TOnErrorLoadEvent;
   FOnRemove: TOnRemoveEvent;
   FMsg: TXWebLoaderMessage;
   procedure SyncOnFinish;
   procedure SyncOnError;
   procedure CheckAbort(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  protected
    procedure Execute; override;
    procedure Remove(Sender: TObject);
  public
    constructor Create(Suspended: Boolean);
    destructor Destroy; override;
    procedure GetData(const XWebLink,Parameter,Cookie,DeviceName :string; MessageID,Digit: Integer);
    property OnFinish: TOnFinishLoadEvent read FOnFinish write FOnFinish;
    property OnError: TOnErrorLoadEvent read FOnError write FOnError;
    property OnRemove: TOnRemoveEvent read FOnRemove write FOnRemove;
  end;



implementation

{ TXWebLoader }

procedure TXWebLoader.CheckAbort(Sender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);  // auch ein Versuch den Socket Error der Indys beim Programm Beenden zu kompensieren
begin                  // war ein Tipp in einem Beitrag. Hier kommt das Programm gar nicht an. Die Threads werden 
  if Terminated then   // einfach abgewürgt
    FHTTP.Disconnect;
end;

constructor TXWebLoader.Create(Suspended: Boolean);
begin
  inherited Create(Suspended);
  FCS:= TCriticalSection.Create;
  FHTTP:= TIdHTTP.Create;
  FHTTP.OnWork:= CheckAbort;
  FMsg:= TXWebLoaderMessage.Create;
  Self.OnTerminate:= Remove;
end;

destructor TXWebLoader.Destroy;
begin
  FHTTP.Free;
  FMsg.Free;
  FreeAndNil(FCS);
  inherited;
end;

procedure TXWebLoader.Execute;
var
  XWebParameter: TStringStream;
  ResponseStream: TStringStream;
  sl: TStringList;
begin
  inherited;
  if not Terminated then
  begin
    sl:= TStringList.Create;
    try
      XWebParameter:= TStringStream.Create(FParameter);
      try
        ResponseStream:= TStringStream.Create;
        try
          try
            FHTTP.Request.CustomHeaders.Add(FCookie);
            if FParameter = '' then
              FHTTP.Get(FXWebLink,ResponseStream)
            else
              FHTTP.Post(FXWebLink,XWebParameter,ResponseStream);
            ResponseStream.Position:= 0;
            sl.LoadFromStream(ResponseStream,TEncoding.UTF8);
            FMsg.Data:= sl.Text;
            Synchronize(SyncOnFinish);
          except
            on e: Exception do
              begin  // evt. noch weitere Informationen in Stringlist oder Klasse dafür ?
                FMsg.Data:= e.Message;
                Synchronize(SyncOnError);
              end;
          end;
        finally
          ResponseStream.Free;
        end;
      finally
        XWebParameter.Free;
      end;
    finally
      sl.Free;
    end;
    Sleep(100);  // extra eingefügt
  end;
end;

procedure TXWebLoader.GetData(const XWebLink, Parameter, Cookie, DeviceName :string; MessageID,Digit: Integer);
begin
  FCS.Enter;
  try
    FXWebLink:= XWebLink;
    FParameter:= Parameter;
    FCookie:= Cookie;
    FDeviceName:= DeviceName;
    FMessageID:= MessageID;
    FDigit:= Digit;
    FMsg.ID:= FMessageID;
    FMsg.DeviceName:= FDeviceName;
    FMsg.Digit:= FDigit;
    Self.Start;
  finally
    FCS.Leave;
  end;
end;

procedure TXWebLoader.SyncOnError;
begin
  FCS.Enter;
  try
    if Assigned(FOnError) then
      FOnError(Self,FMsg);
  finally
    FCS.Leave;
  end;
end;

procedure TXWebLoader.SyncOnFinish;
begin
  FCS.Enter;
  try
    if Assigned(FOnFinish) then
      FOnFinish(Self,FMsg);
  finally
    FCS.Leave;
  end;
end;

procedure TXWebLoader.Remove(Sender: TObject);
begin
  FCS.Enter;
  try
    if Assigned(FOnRemove) then
      FOnRemove(Self);
  finally
    FCS.Leave;
  end;
end;

end.