Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   thread beenden sofern vorhanden und erneut starten (https://www.delphipraxis.net/188320-thread-beenden-sofern-vorhanden-und-erneut-starten.html)

whiteF 20. Feb 2016 01:05

Delphi-Version: 5

thread beenden sofern vorhanden und erneut starten
 
hallo,
wieder mal eine threadfrage...

mittels klick in eine listbox soll ein ausgelagerter thread gestartet werden, welcher eine datei prüft ob online und wertet diese dann aus...
den thread habe ich dem grunde nach bereits aufgebaut und es läuft auch soweit.
nur möchte ich einen womöglichen bestehenden Thread der evtl. noch läuft bei klick in die listbox abbrechen und erneut den thread starten. (Meine cpu auslastung steigt bei jedem klick in die listbox um 0,3%)
Es sollten keine "parallele" threads laufen; nur sofern einer vorhanden ist diesen beenden und einen neuen starten.

im onclick des buttons auf der form:
Delphi-Quellcode:
...
procedure TFormSuche.ListBoxBearbeiterClick(Sender: TObject);
var
...
begin
...
    Thread_PictureSearch := TThread_PictureSearch.Create(True);
    Thread_PictureSearch.FreeOnTerminate := False;
    Thread_PictureSearch.Bildname := ImgName;
    Thread_PictureSearch.ApplicationTitle := Application.Title;
    Thread_PictureSearch.Resume;
...
end;
meine thread unit:
Delphi-Quellcode:
unit UnitVTBSuche_Thread_PictureSearch;

interface

uses
  classes, Windows, System.SysUtils, WinInet;

type
  TThread_PictureSearch = class(TThread)
  private
    ThreadStatus : Integer;
    ThreadBildname : String;
    ThreadApplicationTitle : String;
    procedure Sync_Ende;
  public
    property Status: Integer read ThreadStatus write ThreadStatus;
    property Bildname: String read ThreadBildname write ThreadBildname;
    property ApplicationTitle: String read ThreadApplicationTitle write ThreadApplicationTitle;
  protected
    procedure Execute; override;
  end;

implementation

uses UnitSuche;

procedure TThread_PictureSearch.Execute;
var
  ImgExist : Boolean;
  ImgName : String;
begin
  while not Terminated do
  begin
    try
      Status := 1;
// Hier sind die funktionen
      Status := 2;

      Synchronize(Sync_Ende);

    except
      on e: exception do
      begin

      end;
    end;
  Status := 0;
  Terminate;
  end;
end;

procedure TThread_PictureSearch.Sync_Ende;
begin
  FormSuche.groupSuchergebnis.caption := 'TEEEEEEEEEEEEEEEST';
  FormSuche.wb.Hint := '1';
  FormSuche.wb.Navigate2(Bildname);
end;

end.

Luckie 20. Feb 2016 01:37

AW: thread beenden sofern vorhanden und erneut starten
 
Schick dir doch am Ende eine Nachricht an dein Fenster oder löse in Event aus.

Sir Rufo 20. Feb 2016 08:35

AW: thread beenden sofern vorhanden und erneut starten
 
Du solltest das etwas anders aufbauen.

Hier mal ein QuickAndDirty Minimal-Beispiel. Sollte man so allerdings nicht produktiv einsetzen. Für eine vernünftige Implementierung sollte man das noch in einer Klasse kapseln.
Delphi-Quellcode:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class( TForm )
    Edit1: TEdit;
    Label1: TLabel;
    procedure Edit1Change( Sender: TObject );
    procedure FormCreate( Sender: TObject );
  private
    FSucheNach : string;
    FSuchThread: TThread;
    FNeueSuche : Boolean;
    procedure StartSuche( const SucheNach: string );
    procedure SucheCallback( AResult: TObject );
  public

  end;

type
  EOperationCanceled = class( Exception )
  end;

type
  TSuchResult = class

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Edit1Change( Sender: TObject );
begin
  FSucheNach := Edit1.Text;
  if Assigned( FSuchThread )
  then
    begin
      FNeueSuche := true;
      FSuchThread.Terminate;
    end
  else
    begin
      StartSuche( FSucheNach );
    end;
end;

procedure TForm1.FormCreate( Sender: TObject );
begin
  ReportMemoryLeaksOnShutdown := true;
end;

procedure TForm1.StartSuche( const SucheNach: string );
var
  callback: TProc<TObject>;
begin
  if SucheNach = ''
  then
    begin
      Label1.Caption := '';
      exit;
    end;

  Label1.Caption := 'suchen ...';
  callback      := SucheCallback;
  FNeueSuche    := False;
  FSuchThread   := TThread
  {} .CreateAnonymousThread(
    procedure
    var
      I: Integer;
      r: TObject;
    begin
      try
        try
          for I := 1 to 10 do
            begin
              // Ich tu mal so, als ob ich suchen würde
              Sleep( 250 );
              // Bin ich abgebrochen worden?
              if TThread.Current.CheckTerminated
              then
                raise EOperationCanceled.Create( 'Fehlermeldung' );
            end;
          // Ergebnis
          r := TSuchResult.Create;
        except
          // Exception
          r := AcquireExceptionObject( );
        end;

        // Callback aufrufen
        TThread.Synchronize( nil,
          procedure
          begin
            callback( r );
          end );
      finally
        callback := nil;
        r.Free;
      end;
    end );

  FSuchThread.Start;
end;

procedure TForm1.SucheCallback( AResult: TObject );
begin
  FSuchThread := nil;

  if FNeueSuche
  then // wir müssen nochmal suchen
    StartSuche( FSucheNach )
  else if AResult is TSuchResult
  then // wir haben ein Ergebnis
    begin
      Label1.Caption := 'gefunden!';
    end
  else if AResult is EOperationCanceled
  then // wir wurden unterbrochen
    begin
      Label1.Caption := 'abgebrochen!';
    end
  else if AResult is Exception
  then // es gab einen Fehler
    begin
      Label1.Caption := 'FEHLER: ' + Exception( AResult ).Message;
    end
  else // wer weiß, was hier jetzt gekommen ist :o)
    begin
      Label1.Caption := 'Unbekannter Fehler!';
    end;
end;

end.

whiteF 20. Feb 2016 13:10

AW: thread beenden sofern vorhanden und erneut starten
 
danke für die vorschläge.

ich habe es jetzt so gemacht:

> Threadunit in die uses aufgenommen (anstatt im ButtonClick als var deklariert)
>>> private Thread_PictureSearch : TThread_PictureSearch;

> habe eine gloabe variable in die Threadunit aufgenommen
>>> Diese wird bei einer Exception := false
>>> Diese wird bei durchlauf := false

Der Click auf Button sieht dann nun wie folgt aus:

Delphi-Quellcode:
procedure TFormVTBSuche.ListBoxBearbeiterClick(Sender: TObject);
begin
 if MyThreadRunning = True then
  begin
    if Assigned( Thread_PictureSearch ) then
    begin
      Thread_PictureSearch.Terminate;
    end;
  end;

//mache was...

      Thread_PictureSearch := TThread_PictureSearch.Create(False);
      Thread_PictureSearch.FreeOnTerminate := true;
      Thread_PictureSearch.Bildname := ImgName;
      Thread_PictureSearch.ApplicationTitle := Application.Title;
      Thread_PictureSearch.Resume;
      MyThreadRunning := True;
Nun wird wenigsten kein weiterer Thread gestartet.
Jedoch geht die cpu Last dennoch nach oben... :?


.

Delphi-Laie 20. Feb 2016 17:13

AW: thread beenden sofern vorhanden und erneut starten
 
Paß auf, die Wertzuweisungen bei der globalen Variable (die wird ja vermutlich vom VCL-Thread ausgelesen) zu schützen, z.B. in kritische Abschnitte einzubinden bzw. damit zu umhüllen.


Alle Zeitangaben in WEZ +1. Es ist jetzt 01:37 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