AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language thread beenden sofern vorhanden und erneut starten
Thema durchsuchen
Ansicht
Themen-Optionen

thread beenden sofern vorhanden und erneut starten

Ein Thema von whiteF · begonnen am 20. Feb 2016 · letzter Beitrag vom 20. Feb 2016
Antwort Antwort
whiteF

Registriert seit: 14. Okt 2008
45 Beiträge
 
#1

thread beenden sofern vorhanden und erneut starten

  Alt 20. Feb 2016, 01:05
Delphi-Version: 5
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.

Geändert von whiteF (20. Feb 2016 um 02:04 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#2

AW: thread beenden sofern vorhanden und erneut starten

  Alt 20. Feb 2016, 01:37
Schick dir doch am Ende eine Nachricht an dein Fenster oder löse in Event aus.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

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

AW: thread beenden sofern vorhanden und erneut starten

  Alt 20. Feb 2016, 08:35
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.
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
whiteF

Registriert seit: 14. Okt 2008
45 Beiträge
 
#4

AW: thread beenden sofern vorhanden und erneut starten

  Alt 20. Feb 2016, 13:10
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...


.
  Mit Zitat antworten Zitat
Delphi-Laie

Registriert seit: 25. Nov 2005
1.474 Beiträge
 
Delphi 10.1 Berlin Starter
 
#5

AW: thread beenden sofern vorhanden und erneut starten

  Alt 20. Feb 2016, 17:13
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.
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:29 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