Zitat:

Form im onCloseQuery abfragst ob noch Threads laufen.

...das dumme ist nur, daß die Threads stehen bleiben wenn du dich im OnClose OnCloseQuery befindest. (warum auch immer das so ist... wenn das einer logisch erklären kann, bitte) Das war ja mein erster Ansatz... Warten bis die Liste leer ist. Im OnClose / OnCloseQuery kannst du warten bis du schwarz wirst

...aber Danke für deine Hilfe.

Nachtrag: Nur mit WaitFor bringt man den entsprechenden Thread zum weiterlaufen. Funktioniert aber nur bei FreeOnTerminate:= False. Und dann stehen wir wieder am Anfang...wo gebe ich die Threads frei ?

Hallo,

mal ein kleines Konstrukt:

zusammenfalten · markieren

Delphi-Quellcode:

constructor TTestThread.create;
begin
  inherited create(false);
  freeOnTerminate := true;
end;

procedure TTestThread.execute;
begin
  while not terminated do
    begin
      sleep(100);
    end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  ThreadList.Add(TTestThread.Create)
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  showMessage(intToStr(threadList.count));
  threadList.free;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  i : Byte;
begin
  canClose := false;
  while ThreadList.Count > 0 do
    begin
      for i:= ThreadList.count -1 downto 0 do
        begin
          (ThreadList[i] as TTestThread).terminate;
          while not (ThreadList[i] as TTestThread).Terminated do
            begin
              sleep(200);
            end;
           ThreadList.Delete(i);
        end;
    end;
  canClose := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ThreadList := TObjectList.Create(false);
end;

Grüße
Klaus

Danke für deine Mühe...

markieren

Delphi-Quellcode:

for i:= ThreadList.count -1 downto 0 do
  begin
   (ThreadList[i] as TTestThread).terminate;
   while not (ThreadList[i] as TTestThread).Terminated do
   begin
   sleep(200);
   end;
   ThreadList.Delete(i);
 end;

aus dieser Schleife kommst du nicht mehr raus, da die Threads einfach stehen. Da kannst du Terminate setzen wie du willst. Terminated wird nie True, weil die Threads nicht arbeiten. Sprich Threadlist.Count bleibt immer das gleiche. Würden die Threads ganz normal weiterlaufen würde dein Konstrukt funktionieren.

Unter Delphi 2007 funktioniert das Beispiel einwandfrei.

Hallo,

schon merkwürdig.

Wenn ich im execute des Threads ein Sleep von 20 einsetze funktioniert es so
wie Du beschrieben hast.

Wenn ich aber ein Sleep von 100 einsetze terminiert der Thread und ich bekomme am Ende
die Messagebox angezeigt.

Grüße
Klaus

ok... diese Variante hatte ich wie gesgt schon. Allerdings nicht mit Sleep.

Ich geh dann mal zum probieren....bis gleich.

Soooo....

zusammenfalten · markieren

Delphi-Quellcode:

destructor Klasse1.Destroy; // Kommt auf das gleiche raus wie CloseQuery
var I: Integer;
begin
  while not (FThreadList.Count = 0) do
  begin
      if Assigned((FThreadList.Items[0] as TXWebLoader)) then
      begin
        while FThreadList.Count > 0 do
        begin
          for I := FThreadList.Count - 1 to 0 do
          begin
           (FThreadList.Items[0] as TXWebLoader).Terminate;
            // in XE ist Terminated als protected deklariert ! Geht schon mal nicht !
            while not (FThreadList.Items[0] as TXWebLoader).Terminated do
            begin
              Sleep(200);
            end;
          end;
        end;
        FThreadList.Delete(I);
      end;
  end;

also Terminated auskommentiert.

zusammenfalten · markieren

Delphi-Quellcode:

destructor TXWeb.Destroy;
var I: Integer;
begin
  while not (FThreadList.Count = 0) do
  begin
      if Assigned((FThreadList.Items[0] as TXWebLoader)) then
      begin
        while FThreadList.Count > 0 do
        begin
          for I := FThreadList.Count - 1 to 0 do
          begin
           (FThreadList.Items[0] as TXWebLoader).Terminate;
           Sleep(200);
          end;
        end;
        FThreadList.Delete(I);
      end;
  end;

bei beiden Varianten im Execute Sleep(100) eingefügt...

Ergebnis: Die Threads stehen wie eine eins und das Programm ist in einer Endlosschleife.

.. kannst Du mal (so grob) Deine Thread.execute Methode
hier einstellen.

Grüße
Klaus

Zitat:

Ergebnis: Die Threads stehen wie eine eins und das Programm ist in einer Endlosschleife.

Macht mit Sleep keinen Sinn.
Damit hälst du doch nur alle Threads an und das Programm steht für 200 Millisekunden
Du solltest allen Threads die möglichkeit geben ihre Aktionen zu beenden.

Versuchs mal damit

zusammenfalten · markieren

Delphi-Quellcode:

procedure WinProcessMessages;
// Allow Windows to process other system messages
var
  ProcMsg: TMsg;
begin
  while PeekMessage(ProcMsg, 0, 0, 0, PM_REMOVE) do
  begin
    if (ProcMsg.message = WM_QUIT) then
      Exit;
    TranslateMessage(ProcMsg);
    DispatchMessage(ProcMsg);
  end;
end;

gruss

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):

zusammenfalten · markieren

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.