Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Programmieren allgemein (https://www.delphipraxis.net/40-programmieren-allgemein/)
-   -   Delphi TThread, irgendwas mache ich falsch (https://www.delphipraxis.net/196215-tthread-irgendwas-mache-ich-falsch.html)

KodeZwerg 2. Mai 2018 02:14

TThread, irgendwas mache ich falsch
 
Hallo, im folgenden zeige ich eine Pseudo-Funktion die einen Thread startet, trotzdem friert das Programm ein, ich finde nicht meinen Fehler, fällt jemand auf was ich falsch mache dann bitte Hilfe! :thumb:

Ziel sollte sein den Mainthread zu entlasten aber nach wie vor als eine Funktion zu arbeiten wenn im Hauptcode angesprochen (deswegen repeat schleife)
Delphi-Quellcode:
function TFormMain.Machwas ( Const Input : String ) : String;
var
 tmp : String;
 threadrun: boolean;
begin
  threadrun := True;
  TThread.CreateAnonymousThread(
    procedure
    var
     IchBraucheDieseVars: Definitionen;
    begin
      tmp := '';
      IchBraucheDieseVars := IrgendWas.Create;
    try
      tmp := IchBraucheDieseVars.GibMirEinenStringVonWoanders(Input);
    finally
      IchBraucheDieseVars.Free;
    end;
    threadrun := False
    end
  ).Start;
  repeat sleep(5) until not threadrun;
  Result := tmp;
end;
edit
Mit einfrieren meine ich nicht dass das Programm abstürzt sondern hängen bleibt bis funktion fertig ist.
PS: Es friert auch nicht wegen hoher Cpu Last ein, die ist lächerlich gering.

himitsu 2. Mai 2018 03:55

AW: TThread, irgendwas mache ich falsch
 
Dein Hauptthread besteht ausschließlich aus dieser Zeil
Delphi-Quellcode:
repeat sleep(5) until not threadrun;

und nun überlege mal ganz genau was da gemacht wird und wieso es da hängen muß.

Und sollte es mal beim Free knallen, dann bleibt es auch gleich für immer hängen.

Shadowwalker 2. Mai 2018 07:46

AW: TThread, irgendwas mache ich falsch
 
Durch die Zeile
Delphi-Quellcode:
  repeat sleep(5) until not threadrun;
nach .Start; hebst du die Wirkung des Threads wieder komplett auf.

haentschman 2. Mai 2018 08:20

AW: TThread, irgendwas mache ich falsch
 
Moin...:P
Ich weiß nicht wie weit du drinsteckst...es hilft vieleicht (TThread Grundlagen): https://www.delphi-treff.de/tutorial...ascal/threads/

Nathan 2. Mai 2018 08:23

AW: TThread, irgendwas mache ich falsch
 
Wäre dafür nicht das Konzept Futures aus der Delphi Parallel Library. Schau mal unter:
https://www.delphi-treff.de/tutorial...lel-library/4/
http://docwiki.embarcadero.com/RADSt...amming_Library

Shadowwalker 2. Mai 2018 08:42

AW: TThread, irgendwas mache ich falsch
 
Das Problem hier wird sein, dass er eine Funktion als Thread ausführen möchte, aber gleichzeitig im Mainthread auf das Ergebnis warten muss.

himitsu 2. Mai 2018 08:57

AW: TThread, irgendwas mache ich falsch
 
Zitat:

Zitat von Shadowwalker (Beitrag 1401028)
aber gleichzeitig im Mainthread auf das Ergebnis warten muss.

Oder seine Methode ist die Falsche/Unpassende.

Im Thread oder sonstwo was machen, im Hauptthread darauf warten, aber dem Hauptthread Rechenleistung abgeben. (ProcessMessages)

Oder im Thread was machen, im Hauptthread nicht warten und bei ThreadEnde den Hauptthread benachrichtigen (Callback, Message oder Dergleichen),
bzw. im Hauptthread regelmäßig schauen ob fertig und dann das Ergebnis abholen (pollen > Timer).


Und da der Thread selber auch nichts macht, wäre noch die Überlegung, ob ein Thread überhaupt notwendig ist.
Datei- und Streamingfunktion und auch irgendwelches INet-Download-Zeugs (ich vermute mal um Letzteres geht es) muß nicht immer blockierend arbeiten, was sich dann ebenfalls mit Erster und den anderen Lösungen kombinieren ließe.

p80286 2. Mai 2018 09:04

AW: TThread, irgendwas mache ich falsch
 
Zitat:

Zitat von KodeZwerg (Beitrag 1401015)

Ziel sollte sein den Mainthread zu entlasten aber nach wie vor als eine Funktion zu arbeiten wenn im Hauptcode angesprochen (deswegen repeat schleife)

Nö, das geht nicht (OK, man kann es gehend machen) und es ist unnötig. Ein Thread hat eine Aufgabe zu erledigen. Für diese wird er aufgerufen. Wenn diese erledigt ist ist zwar der Code noch vorhanden aber der Thread selbst ist nicht mehr aktiv. Falls die Aufgabe nochmals zu erledigen ist, wird er erneut aufgerufen.

Gruß
K-H

himitsu 2. Mai 2018 09:23

AW: TThread, irgendwas mache ich falsch
 
@p80286: Du hast seinen Code und diese Aussage falsch verstanden.

Diese Schleife hat nichts mit dem Thread zu tun.
Sie soll nur warten und dafür ist "diese" Schleife garnicht nötig.
Einfache Abänderung, mit dem selben Ergebnis: Ein Event und WaitFor statt dieser Schleife.


Er kann bei sich auch das Sleep weglassen. Dann ist der Code kürzer, das Warten verbrät 100% CPU, aber sonst ändert sich nichts.

Mavarik 2. Mai 2018 09:54

AW: TThread, irgendwas mache ich falsch
 
Ein generelles Problem...

Es gibt im Hauptthread keine Procedure Execute_Modal_In_Thread;. Wie himitsu schon geschrieben hat...

Ein

Delphi-Quellcode:
Procedure Button1Click(Sender : TObject);
begin
  MachWaslangesImThread;
  IchWarteHiersolangenonBlocking;
end;
Geht leider nicht...

Alle Repeat Processmessages Until Konstrukte verbraten nur mehr CPU-Zeit, als wenn man es direkt im UI-Thread erledigt hätten.

Also die Logik umbauen auf.


Delphi-Quellcode:
Procedure Button1Click(Sender : TObject);
begin
  ShowWait;
  MachWaslangesImThreadAsync(Procedure (Data : TData)
    begin
      IcharbeitemitdemErgebnis(Data);
      HideWait;
    end);
end;
Wird zwar dadurch nicht schneller, aber die Oberfläche bleibt reaktiv.

Multithreading lohnt sich "eigentlich" nur da, wo der User nicht unbedingt auf ein Ergebnis wartet.

Beispiel (Schönwetter Code, wie Bernd sagen würde) :

Delphi-Quellcode:
Procedure SaveButton(Sender : TObject);
begin
  SaveButton.Enabled := false;
  TTask.Run(Procedure
    begin
      SpeicherdieDaten;  
      TThread.Queue(NIL,Procedure
        begin
          ShowFlyInMessage('Daten gespeichert');
          SaveButton.Enabled := true;
        end;
    end);
end;
Nur mal so als Anregungen.

Mavarik :coder:

Zacherl 2. Mai 2018 11:28

AW: TThread, irgendwas mache ich falsch
 
Zitat:

Zitat von KodeZwerg (Beitrag 1401015)
Ziel sollte sein den Mainthread zu entlasten aber nach wie vor als eine Funktion zu arbeiten wenn im Hauptcode angesprochen

Das geht schon ein wenig in die Richtung "Future" und "Promise". Die Delphi Threading Lib hatte sowas in der Art auch implementiert meine ich.

Edit:
http://docwiki.embarcadero.com/RADSt...amming_Library

p80286 2. Mai 2018 12:23

AW: TThread, irgendwas mache ich falsch
 
Zitat:

Zitat von himitsu (Beitrag 1401037)
@p80286: Du hast seinen Code und diese Aussage falsch verstanden.

Mag sein, aber ich habe schon soviel Multitasking-Voodoo gelesen, darum wundert mich nichts.

Gruß
K-H

Codehunter 2. Mai 2018 13:01

AW: TThread, irgendwas mache ich falsch
 
Tut sich nicht jeder am Anfang schwer wenn er in Parallelprogrammierung einsteigt? Ich habe selbst derzeit auch so ein verwandtes Thema am kochen. Ich denke, bei Parallelisierung braucht es mehr als anderswo eine gute konzeptionelle Vorarbeit. Einfach drauflos und gucken was passiert ist IMHO der falsche Weg.

Ich selbst habe mir Threads immer so vorgestellt wie Systemdienste beim Windows. Laufen im Hintergrund und erledigen Aufgaben, die nicht visualisiert werden müssen. Wenn sie fertig sind oder zwischendurch Statusmeldungen absondern müssen, dann über synchronisierte Eventhandler zum GUI-Hauptthread hin. Deshalb ist es ja auch gerade so widersinnig, den Hauptthread in eine repeat-until-Schleife zu schicken, während der Thread im Hintergrund sein Werk tut. Das wäre ja so als müsste man an einem Windows Domaincontroller erstmal alle Dienste beenden, um über das GUI eine Wartung vornehmen zu können.

KodeZwerg 2. Mai 2018 13:26

AW: TThread, irgendwas mache ich falsch
 
Ja Danke für Eure Aussagen,
himitsu hat Recht, es handelt sich um die inet-download Geschichte.
Ich werde mich mal bei den Links von euch durchlesen wie ich es korrekt anstellen sollte.

Es geht mir nicht um parallele Threads, einfach nur ein Thread der arbeitet und wenn er fertig ist mir ein Ergebnis liefert aber solange wie er arbeitet das Programm nicht blockiert wird, und das ganze bei Laufzeit.
Da soll noxh eine Thread-Abbruch Funktion rein damit sich das ganze Thread Gedöns auch lohnt nur kann ich nicht den Abbruch-Knopf drücken weil "keine Rückmeldung" erscheint.

Zitat:

Zitat von himitsu (Beitrag 1401037)
Einfache Abänderung, mit dem selben Ergebnis: Ein Event und WaitFor statt dieser Schleife.

Ja das versuche ich gerade innerhalb der Funktion umzusetzen/einzubauen. Ich hoffe in einem der Links steht was darüber


Das mit Future ist die falsche Richtung, Danke für die Hinweise @mehrere

edit
Code:
WaitForSingleObject(MyThread.Handle, INFINITE);
Das teste ich gerade als Ersatz für die repeat Schleife aber Programm friert immer noch ein.

So sieht jetzt eine real-Funktion aus:
Delphi-Quellcode:
function TFormMain.GetTHTTPClient ( Const xURL : String ) : String;
var
 tmp : String;
 MyThread: TThread;
begin
  tmp := '';
  MyThread := TThread.CreateAnonymousThread(
    procedure
    var
     HttpClient: THttpClient;
     HttpResponse: IHttpResponse;
    begin
      tmp := '';
      HttpClient := THTTPClient.Create;
      try
        HttpResponse := HttpClient.Get( xURL );
        tmp := HttpResponse.ContentAsString();
      finally
        HttpClient.Free;
      end;
    end
  );
  MyThread.FreeOnTerminate := True;
  MyThread.Start;
  WaitForSingleObject(MyThread.Handle, INFINITE);
  Result := tmp;
end;

p80286 2. Mai 2018 14:14

AW: TThread, irgendwas mache ich falsch
 
Zitat:

Zitat von KodeZwerg (Beitrag 1401085)
Es geht mir nicht um parallele Threads, einfach nur ein Thread der arbeitet und wenn er fertig ist mir ein Ergebnis liefert aber solange wie er arbeitet das Programm nicht blockiert wird, und das ganze bei Laufzeit.

Unter Windows gibt es immer einen "MainThread" der nichts anderes Tut als

Code:
repeat
  GibtesMessages;
  verarbeiteMessages;
  Gibtes Events;
  VerarbeiteEvents;
  // ab hier meine Erweiterungen
  Machwas;
until terminated;
Wenn Machwas zeitaufwendig ist, dann macht das Programm den Eindruck eingefroren zu sein.
Um dieses Einfrieren zu verhindern, wird die zeitaufwendige Aktion in einen seperaten Thread ausgelagert, damit der Hauptthread wieder seiner Aufgabe "Anzeigen und Reagieren" nachkommen kann.

Gruß
K-H

himitsu 2. Mai 2018 14:24

AW: TThread, irgendwas mache ich falsch
 
Zitat:

Zitat von KodeZwerg (Beitrag 1401085)
Zitat:

Zitat von himitsu (Beitrag 1401037)
Einfache Abänderung, mit dem selben Ergebnis: Ein Event und WaitFor statt dieser Schleife.

Ja das versuche ich gerade innerhalb der Funktion umzusetzen/einzubauen. Ich hoffe in einem der Links steht was darüber

Das war gerade DAS Antibeispiel, wo man auch im Code gleich sieht, dass es hängen muß. :angle2:

Zitat:

Zitat von KodeZwerg (Beitrag 1401085)
Das mit Future ist die falsche Richtung, Danke für die Hinweise @mehrere

Wieso?
> Mach was und wenn fertig gib es mir.

Zitat:

Zitat von p80286 (Beitrag 1401092)
Um dieses Einfrieren zu verhindern, wird die zeitaufwendige Aktion in einen seperaten Thread ausgelagert, damit der Hauptthread wieder seiner Aufgabe "Anzeigen und Reagieren" nachkommen kann.

Oder der Entwickler muß dem Hauptthread regelmäßig die Möglichkeit geben etwas anderes tun zu können.

Whookie 2. Mai 2018 14:33

AW: TThread, irgendwas mache ich falsch
 
Grundsätzlich geht es dabei wohl darum wie man das Ergebnis aus dem Thread kriegt. Ganz einfach wäre folgendes:

Delphi-Quellcode:

procedure TMainForm.GetTHTTPClient ( Const xURL : String );
begin
  TThread.CreateAnonymousThread(
    procedure
    var
     HttpClient: THttpClient;
     HttpResponse: IHttpResponse;
     LTmp: String;
    begin
      Ltmp := '';
      HttpClient := THTTPClient.Create;
      try
        HttpResponse := HttpClient.Get( xURL );
        Ltmp := HttpResponse.ContentAsString();
      finally
        HttpClient.Free;
        TThread.Synchronize(TThread.Current,
          Procedure
          begin
            DoneWithIt(Ltmp);
          end
        );
      end;
    end
  ).Start;
end;

procedure TMainForm.DoneWithIt(const Data: String);
begin
  label1.Caption := 'DoneWithIt: '+Data;
end;
Natürlich muss es dann noch einen entsprechenden Label geben, oder man macht mit Data was immer man möchte... :wink:

KodeZwerg 2. Mai 2018 14:54

AW: TThread, irgendwas mache ich falsch
 
Delphi-Quellcode:
  while WaitForSingleObject(MyThread.Handle, INFINITE) = WAIT_OBJECT_0 do Application.ProcessMessages;
scheint auch nicht zu helfen.
@Whookie: Ich verstehe zwar wie Du es meinst aber kann es so noch nicht praktikabel umsetzen.

Neutral General 2. Mai 2018 15:01

AW: TThread, irgendwas mache ich falsch
 
Du wartest ja auch unendlich lange :roll:

Mach ein Timeout von wenigen Millisekunden und dann gehts auch.

KodeZwerg 2. Mai 2018 15:15

AW: TThread, irgendwas mache ich falsch
 
Hier ist der komplette Source im "so ist es gerade in meiner IDE" Zustand.
Whookies Vorschlag ist gerade zum Test drinnen aber ich komme damit noch nicht ganz klar.
Bei mir waren es halt Funktionen weil ich ja das Result abwarten muss.


In Arbeit ist halt gerade "GetTHTTPClient" Funktion/Prozedur, als Prozedur bekomme ich es so noch nicht zum laufen.

Delphi-Quellcode:
unit uMain;

interface

uses
  Winapi.Windows, Vcl.Controls, Vcl.StdCtrls, Vcl.Dialogs, System.Classes,
  Vcl.ExtCtrls, Vcl.Forms, System.SysUtils, System.Diagnostics;

type
  TFormMain = class(TForm)
    PanelTop: TPanel;
    PanelClient: TPanel;
    MemoText: TMemo;
    EditURL: TEdit;
    ButtonDownload: TButton;
    ButtonSaveOriginal: TButton;
    FileSaveDialog1: TFileSaveDialog;
    ButtonSaveMemo: TButton;
    ComboBoxApi: TComboBox;
    PanelBenchmark: TPanel;
    CheckBoxBenchmark: TCheckBox;
    GroupBoxBenchConfig: TGroupBox;
    ComboBoxBitsBytes: TComboBox;
    ComboBoxByteCalc: TComboBox;
    procedure ButtonDownloadClick(Sender: TObject);
    procedure ButtonSaveOriginalClick(Sender: TObject);
    procedure ButtonSaveMemoClick(Sender: TObject);
    procedure CheckBoxBenchmarkClick(Sender: TObject);
  private
    { Private declarations }
    DataString: String;
    MyThreadRun: Boolean;
    Function GetWinInet ( Const xURL : String ) : UTF8String;
    Function GetHttpApi ( Const xURL : String ) : String;
    Function GetTDownloadURL ( Const xURL : String ) : String;
//    function GetTHTTPClient( Const xURL : String ) : String;
    Procedure GetTHTTPClient( Const xURL : String );
    procedure DoneWithIt ( Const Data: String );
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

Uses
  WinApi.WinInet,
  System.Variants, WinApi.ActiveX, System.Win.ComObj,
  Vcl.ExtActns,
  System.Net.HttpClient
  ;

{$R *.dfm}

function TFormMain.GetWinInet ( Const xURL : String ) : UTF8String;
var
 tmp : String;
 threadrun: boolean;
begin
  tmp := '';
  threadrun := True;
  TThread.CreateAnonymousThread(
    procedure
    var
     NetHandle: HINTERNET;
     UrlHandle: HINTERNET;
     Buffer: array[0..1023] of byte;
     BytesRead: dWord;
     StrBuffer: UTF8String;
    begin
      NetHandle := InternetOpen('Delphi-PRAXiS RockZ', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
      if Assigned(NetHandle) then
      try
        UrlHandle := InternetOpenUrl(NetHandle, PChar(xURL), nil, 0, INTERNET_FLAG_RELOAD, 0);
        if Assigned(UrlHandle) then
        try
          repeat
            InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
            SetString(StrBuffer, PAnsiChar(@Buffer[0]), BytesRead);
            tmp := tmp + StrBuffer;
          until BytesRead = 0;
        finally
          InternetCloseHandle(UrlHandle);
        end
      else
        raise Exception.CreateFmt('Cannot open URL %s', [xURL]);
    finally
      InternetCloseHandle(NetHandle);
      threadrun := False
    end
    else
      raise Exception.Create('Unable to initialize Wininet');
      threadrun := False
    end
  ).Start;
  repeat sleep(5) until not threadrun;
  Result := tmp;
end;

Function TFormMain.GetHttpApi ( Const xURL : String ) : String;
var
 tmp : String;
 threadrun: boolean;
begin
  tmp := '';
  threadrun := True;
  TThread.CreateAnonymousThread(
    procedure
    var HTTP: OleVariant;
    begin
      CoInitialize(nil);
      try
        HTTP := CreateOleObject('WinHttp.WinHttpRequest.5.1');
        HTTP.Open('GET', xURL, False);
        HTTP.SetRequestHeader('User-Agent', 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0');
        HTTP.Send;
        tmp := HTTP.ResponseText;
      finally
        HTTP := Unassigned;
        CoUninitialize;
      end;
      threadrun := False
    end
  ).Start;
  repeat sleep(5) until not threadrun;
  Result := tmp;
end;

Function TFormMain.GetTDownloadURL ( Const xURL : String ) : String;
var
  dl: TDownloadURL;
  iFileHandle: Integer;
  iFileLength: Integer;
  iBytesRead: Integer;
  Buffer: PAnsiChar;
  i: Integer;
begin
  Result := '';
  if FileSaveDialog1.Execute then
  begin
    dl := TDownloadURL.Create(Self);
    try
      dl.URL := xURL;
      dl.FileName := FileSaveDialog1.FileName;
      dl.ExecuteTarget(nil);
    finally
      dl.Free;
      try
        iFileHandle := System.SysUtils.FileOpen(FileSaveDialog1.FileName, fmOpenRead);
        iFileLength := System.SysUtils.FileSeek(iFileHandle,0,2);
        System.SysUtils.FileSeek(iFileHandle,0,0);
        Buffer := System.AllocMem(iFileLength + 1);
        iBytesRead := System.SysUtils.FileRead(iFileHandle, Buffer^, iFileLength);
        Result := Buffer;
      finally
        System.SysUtils.FileClose(iFileHandle);
        System.FreeMem(Buffer);
      end;
    end;
  end;
end;

{
function TFormMain.GetTHTTPClient ( Const xURL : String ) : String;
var
 tmp : String;
 MyThread: TThread;
begin
  tmp := '';
  MyThread := TThread.CreateAnonymousThread(
    procedure
    var
     HttpClient: THttpClient;
     HttpResponse: IHttpResponse;
    begin
      tmp := '';
      HttpClient := THTTPClient.Create;
      try
        HttpResponse := HttpClient.Get( xURL );
        tmp := HttpResponse.ContentAsString();
      finally
        HttpClient.Free;
      end;
    end
  );
  MyThread.FreeOnTerminate := True;
  MyThread.Start;
  while WaitForSingleObject(MyThread.Handle, INFINITE) = WAIT_OBJECT_0 do Application.ProcessMessages;
  Result := tmp;
end;}

procedure TFormMain.GetTHTTPClient ( Const xURL : String );
begin
  TThread.CreateAnonymousThread(
    procedure
    var
     HttpClient: THttpClient;
     HttpResponse: IHttpResponse;
     LTmp: String;
    begin
      Ltmp := '';
      MyThreadRun := True;
      HttpClient := THTTPClient.Create;
      try
        HttpResponse := HttpClient.Get( xURL );
        Ltmp := HttpResponse.ContentAsString();
      finally
        HttpClient.Free;
        TThread.Synchronize(TThread.Current,
          Procedure
          begin
            DoneWithIt(Ltmp);
          end
        );
      end;
    end
  ).Start;
end;

procedure TFormMain.DoneWithIt ( Const Data: String );
begin
  DataString := Data;
  MyThreadRun := False;
end;

procedure TFormMain.ButtonDownloadClick(Sender: TObject);
var
  temp1, temp2: String;
  i : Integer;
  Watch: TStopWatch;
begin
  MemoText.Clear;
  ButtonDownload.Enabled := False;
  ButtonSaveOriginal.Enabled := False;
  ButtonSaveMemo.Enabled := False;
  PanelBenchmark.Enabled := False;
  Temp1 := EditURL.Text; Temp2 := ''; DataString := '';
  MemoText.Refresh;
  MemoText.Lines.Add('Downloading Data from ' +Temp1);
  MemoText.Lines.Add('Please Wait...');
  if CheckBoxBenchmark.Checked then
  begin
    Watch := TStopWatch.Create();
    Watch.Start;
  end;
  if Length(Temp1) > 0 then
   case ComboBoxApi.ItemIndex of
    0: DataString := GetWinInet( Temp1 );
    1: DataString := GetHttpApi( Temp1 );
    2: DataString := GetTDownloadURL( Temp1 );
//    3: DataString := GetTHTTPClient( Temp1 );
    3: begin
        GetTHTTPClient( Temp1 );
        while MyThreadRun do Application.ProcessMessages;
       end;
   end; // case
  if CheckBoxBenchmark.Checked then Watch.Stop;
  if Length(DataString) > 0 then
  begin
    MemoText.Lines.Text := DataString;
    i := Length(MemoText.Lines.Text) ;
    MemoText.Lines.Add('');
    MemoText.Lines.Add('HTTP/S HTML Source from: '+Temp1);
    if Length(DataString)-i < 0 then temp2 := 'Additional added '+IntToStr(i-Length(DataString))+' extra Unicode bytes.';
    if Length(DataString)-i = 0 then temp2 := 'Plain Ascii detected.';
    if Length(DataString)-i > 0 then temp2 := 'Warning! '+IntToStr(Length(DataString)-i)+' bytes missing in Display!';
    MemoText.Lines.Add('Downloaded: '+IntToStr(Length(DataString)) +' bytes, displaying: ' +IntToStr(i)+ ' chars. '+temp2);
    if CheckBoxBenchmark.Checked then
    begin
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 1))and((ComboBoxByteCalc.ItemIndex = 0)or(ComboBoxByteCalc.ItemIndex = 1))) then
        MemoText.Lines.Add('Downloaded needed '+IntToStr(Watch.ElapsedMilliseconds)+' ms, that is '+FloatToStrF(Length(DataString) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' bytes/second <-> '+FloatToStrF((Length(DataString) / 1024) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' kbyte/s <-> '+FloatToStrF((Length(DataString) / 1024 / 1024) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' mbyte/s.');
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 2))and((ComboBoxByteCalc.ItemIndex = 0)or(ComboBoxByteCalc.ItemIndex = 1))) then
        MemoText.Lines.Add('Downloaded needed '+IntToStr(Watch.ElapsedMilliseconds)+' ms, that is '+FloatToStrF((Length(DataString)*8) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' bits/second <-> '+FloatToStrF(((Length(DataString)*8) / 1024) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' kbit/s <-> '+FloatToStrF(((Length(DataString)*8) / 1024 / 1024) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' mbit/s.');
      if ((ComboBoxBitsBytes.ItemIndex = 0) and (ComboBoxByteCalc.ItemIndex = 0)) then
        MemoText.Lines.Add('Above calculations based on 1024 byte = 1 kb for your pleasure 1000 byte = 1 kb follows.');
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 1))and((ComboBoxByteCalc.ItemIndex = 0)or(ComboBoxByteCalc.ItemIndex = 2))) then
        MemoText.Lines.Add('Downloaded needed '+IntToStr(Watch.ElapsedMilliseconds)+' ms, that is '+FloatToStrF(Length(DataString) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' bytes/second <-> '+FloatToStrF((Length(DataString) / 1000) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' kbyte/s <-> '+FloatToStrF((Length(DataString) / 1000 / 1000) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' mbyte/s.');
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 2))and((ComboBoxByteCalc.ItemIndex = 0)or(ComboBoxByteCalc.ItemIndex = 2))) then
      MemoText.Lines.Add('Downloaded needed '+IntToStr(Watch.ElapsedMilliseconds)+' ms, that is '+FloatToStrF((Length(DataString)*8) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' bits/second <-> '+FloatToStrF(((Length(DataString)*8) / 1000) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' kbit/s <-> '+FloatToStrF(((Length(DataString)*8) / 1000 / 1000) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' mbit/s.');
    end;
    ButtonSaveOriginal.Enabled := True;
    ButtonSaveMemo.Enabled := True;
  end;
  PanelBenchmark.Enabled := True;
  ButtonDownload.Enabled := True;
end;

procedure TFormMain.ButtonSaveOriginalClick(Sender: TObject);
var
 FS: TFileStream;
 xBuf: TBytes;
 i: Integer;
begin
 if FileSaveDialog1.Execute then
 begin
   SetLength(xBuf, Length(DataString)-1);
   for i := 1 to Length(DataString) do
    xBuf[i-1] := Ord(DataString[i]);
   FS := TFileStream.Create(FileSaveDialog1.FileName, fmCreate);
   FS.WriteBuffer(xBuf, 0, Length(DataString));
   FS.Free;
 end;
end;

procedure TFormMain.ButtonSaveMemoClick(Sender: TObject);
begin
 if FileSaveDialog1.Execute then
 begin
   MemoText.Lines.SaveToFile(FileSaveDialog1.FileName);
 end;
end;

procedure TFormMain.CheckBoxBenchmarkClick(Sender: TObject);
begin
 GroupBoxBenchConfig.Enabled := CheckBoxBenchmark.Checked;
end;

end.

KodeZwerg 2. Mai 2018 16:14

AW: TThread, irgendwas mache ich falsch
 
Danke NG, jetzt hab ich verstanden was Du mit der Zeit meintest und Erfolgreich umgesetzt.
Falls es jemand Interessiert, hier die Lösung für mein Problem
Delphi-Quellcode:
function TFormMain.GetTHTTPClient ( Const xURL : String ) : String;
var
 tmp : String;
 MyThread: TThread;
begin
  tmp := '';
  MyThread := TThread.CreateAnonymousThread(
    procedure
    var
     HttpClient: THttpClient;
     HttpResponse: IHttpResponse;
    begin
      tmp := '';
      HttpClient := THTTPClient.Create;
      try
        HttpResponse := HttpClient.Get( xURL );
        tmp := HttpResponse.ContentAsString();
      finally
        HttpClient.Free;
      end;
    end
  );
  MyThread.FreeOnTerminate := True;
  MyThread.Start;
  repeat
    Application.ProcessMessages;
    Sleep(5);
  until WaitForSingleObject(MyThread.Handle, 5) = WAIT_FAILED;
  Result := tmp;
end;
Das Programm kann man weiterhin bedienen, nichts friert ein.
Danke für alle Hinweise und Tipps!

himitsu 2. Mai 2018 21:01

AW: TThread, irgendwas mache ich falsch
 
Delphi-Quellcode:
Sleep(5);
  until WaitForSingleObject(MyThread.Handle, 5)
Ein paar Dinge verstehen könntest du dennoch lernen :zwinker:

Sleep(5)_ohneEventbehandlung + WaitFor(5)_mitEventbehandlung = WaitFor(10)_undAllesMitEventbehandlung

Oder noch besser das WaitFor nicht nur auf dein Event, sondern auch auf die Warteschlange des VCL-Threads warten lassen.
> Delphi-Referenz durchsuchenDelay etwas anpassen

Whookie 3. Mai 2018 06:32

AW: TThread, irgendwas mache ich falsch
 
Man kann das natürlich so lösen, aber meist führt das zu weiteren Problemen (z.B. kann der Anwender das Programm nicht mehr beenden während es in einer solchen Schleife "festhängt").

Schleifen in denen Sleep und ProcessMessages verwendet werden sollte man aus meiner Sicht meiden, wenn ein Vorgang in Summe länger dauert dann gehört der ganze Vorgang in den Thread nicht nur Teile davon.

Klar bedeutet das in der Regel einen gewissen Umbauaufwand aber in den meisten Fällen hat man einfach nur "zu kurz" gedacht.

himitsu 3. Mai 2018 10:06

AW: TThread, irgendwas mache ich falsch
 
Application.Terminated in die Abbruchbedingung sollte halt mit rein, dann läßt es sich beenden, genau so, wie man es auch bei Threads mit Self.Terminated macht.

KodeZwerg 3. Mai 2018 10:16

AW: TThread, irgendwas mache ich falsch
 
Delphi-Quellcode:
  MyThread.FreeOnTerminate := True;
  MyThread.Start;
  repeat
    Application.ProcessMessages;
    Sleep(5);
    if CancelThread then
    begin
      ButtonDownload.Enabled := True;
      ButtonSaveOriginal.Enabled := False;
      ButtonCancelDownload.Enabled := False;
      CancelThread := False;
      tmp := 'Download aborted.';
      MyThread.Terminate;
    end;
  until WaitForSingleObject(MyThread.Handle, 5) = STATUS_PENDING;
So sieht es aktuell aus, Abbruch-Bedingung ist ein Globales Boolean, gesteuert über Knopf.
Momentan klappt allerdings irgendwie gar nichts so richtig.
Das mit den Sleep(5) ist irgendwie ein Automatismus bei mir, sobald ich ProcessMessages aufrufe.

Neutral General 3. Mai 2018 12:04

AW: TThread, irgendwas mache ich falsch
 
Musst du denn wirklich auf den Thread warten?
Reicht ein Callback aus dem Thread oder ein OnTerminated nicht in dem du deine Buttons etc wieder enablest/disablest?

Selbst wenn es so wie du es grade machst irgendwann funktionieren sollte wie du willst ist es trotzdem nichts von dem man behaupten kann, dass dort Threads sinnvoll eingesetzt werden. Oder anders gesagt: Wenn man auf einen Thread warten muss, dann stellt sich zumindest die Frage ob ein Thread in dem Fall eine gute Idee ist.
(Meistens nicht, manchmal vllt doch).

KodeZwerg 3. Mai 2018 13:00

AW: TThread, irgendwas mache ich falsch
 
@NG: Um ehrlich zu sein, ich weiß nicht ob ein Thread das Richtige Mittel ist.
Es nur eine Idee die ich mal ausprobieren wollte um an dieses Ziel zu gelangen:
Behebe bei App "keine Rückmeldung" und biete Option an den Download abzubrechen.
Mal klappt es mal nicht, ich spiele zu viel mit der until Bedingung rum.
Wenn ich wieder die kombination drinnen habe die funktioniert, also das ich entweder was downloade und wenn thread beendet ist es mir auch angezeigt wird, dann klappt es mit der "Download aborted." Nachricht nicht. Thread ist dann zwar abgebrochen aber ohne Nachricht ist es auch doof. Naja ich bastel da noch ein wenig herum.
Ohne Extra-Thread fehlt mir die Möglichkeit den Download abzubrechen und App friert ein solange Download am machen ist.

Edelfix 3. Mai 2018 13:43

AW: TThread, irgendwas mache ich falsch
 
Sollte eigentlich so funktionieren.
Delphi-Quellcode:
function TMainForm.GetTHTTPClient ( Const xURL : String ) : String;
var
 tmp : String;
 MyThread: TThread;
 TimeOut: Cardinal;
begin
  tmp := '';
  MyThread := TThread.CreateAnonymousThread(
    procedure
    var
     HttpClient: THttpClient;
     HttpResponse: IHttpResponse;
    begin
      tmp := '';
      HttpClient := THTTPClient.Create;
      try
        HttpResponse := HttpClient.Get( xURL );
        tmp := HttpResponse.ContentAsString();
      finally
        HttpClient.Free;
      end;
    end
  );
  MyThread.FreeOnTerminate := True;
  TimeOut := GetTickCount;
  MyThread.Start;
  repeat
    Application.ProcessMessages;
    Sleep(5);
  until (tmp<>'') or ((GetTickCount-TimeOut)>5000); //neu
  Result := tmp;
end;

KodeZwerg 3. Mai 2018 15:09

AW: TThread, irgendwas mache ich falsch
 
Delphi-Quellcode:
  until ((tmp <> '') or (WaitForSingleObject(MyThread.Handle, 5) = WAIT_FAILED));
Das ist die Lösung, auf den String zu achten, super Idee Edelfix. Danke! Nun klappt es exakt so wie ich es wollte, ich kann abbrechen, ich bekomme 'Download aborted.' und Thread schließt sich bzw bei Nicht-Abbruch bekomme ich auch das Ergebnis :thumb::thumb:

edit
Falls jemand mal brauchen sollte, so sieht eine Funktion aus die einen Thread startet und wartet bis der fertig ist um aus dem Thread einen String als Funktion = Result zu überreichen. Eine Abbruch-Funktion ist per Boolean CancelThread integriert.
Delphi-Quellcode:
function TFormMain.GetTHTTPClient ( Const xURL : String ) : String;
var
 tmp : String;
 MyThread: TThread;
begin
  tmp := '';
  CancelThread := False;
  MyThread := TThread.CreateAnonymousThread(
    procedure
    var
     HttpClient: THttpClient;
     HttpResponse: IHttpResponse;
    begin
      HttpClient := THTTPClient.Create;
      try
        HttpResponse := HttpClient.Get( xURL );
        tmp := HttpResponse.ContentAsString();
      finally
        HttpClient.Free;
      end;
    end
  );
  MyThread.FreeOnTerminate := True;
  MyThread.Start;
  repeat
    Application.ProcessMessages;
    Sleep(5);
    if CancelThread then
    begin
      ButtonDownload.Enabled := True;
      ButtonSaveOriginal.Enabled := False;
      ButtonCancelDownload.Enabled := False;
      CancelThread := False;
      tmp := 'Download aborted.';
      MyThread.Terminate;
    end;
  until ((tmp <> '') or (WaitForSingleObject(MyThread.Handle, 5) = WAIT_FAILED));
  Result := tmp;
end;
Durch die Art der Abfrage in der Repeat-Schleife sollte meines Wissens alles glatt laufen, entweder es existiert ein String oder Thread hat sich geschlossen.
Was haltet Ihr davon?

Stevie 3. Mai 2018 15:17

AW: TThread, irgendwas mache ich falsch
 
Bitte niemals auf das Handle eines Threads mit
Delphi-Quellcode:
FreeOnTerminate := True
warten!
An der Stelle, wo das Warten passiert, kann der Thread schon durchgelaufen und weg sein.

KodeZwerg 3. Mai 2018 15:37

AW: TThread, irgendwas mache ich falsch
 
Aber das ist es doch, ich warte bis Handle nicht mehr gefunden wird (WAIT_FAILED)
Wie könnte ich es besser machen?

Fritzew 3. Mai 2018 15:41

AW: TThread, irgendwas mache ich falsch
 
Aber wieso eigentlich?
Wenn der Thread fertig ist, das dem Mainthread mitteilen.
Da gibt es ja jede Menge Möglichkeiten. Aber pollen ist unnötig meiner Meinung nach.
Über Synchchronize oder eine Message wie auch immer.
Abbrechen kannst Du den HttpClient.Get ja sowieso nicht...

KodeZwerg 3. Mai 2018 15:46

AW: TThread, irgendwas mache ich falsch
 
Also ProcessExplorer zeigt mir an das ein seperater Thread gestartet ist, wenn ich auf "Cancel Download" klicke wird "CancelThread := True;" gesetzt und der Thread ist verschwunden, meinst Du der lädt dann trotzdem noch weiter bzw wie könnte ich das unterbinden?
edit
Ok ich kann nun nachvollziehen was Du meinst und habe das Problem so gelöst:
Delphi-Quellcode:
MyThread.Terminate; // das hier (beschreibung sagt Thread arbeit sich erst ab)
Winapi.Windows.TerminateProcess(MyThread.Handle, 0); // mit dem ersetzt (das schliesst sofort eine Instanz)

//bzw jetzt die Friss oder Stirb methode
if not Winapi.Windows.TerminateProcess(MyThread.Handle, 0) then MyThread.Terminate;

Fritzew 4. Mai 2018 09:56

AW: TThread, irgendwas mache ich falsch
 
Um Himmels willen........
Delphi-Quellcode:
//bzw jetzt die Friss oder Stirb methode
if not Winapi.Windows.TerminateProcess(MyThread.Handle, 0) then MyThread.Terminate;
Das ist jetzt aber nur noch falsch, schau mal in die Docu von TerminateProcess
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx


Warum nicht einfach so etwas:
Form:
Delphi-Quellcode:
object Form5: TForm5
  Left = 0
  Top = 0
  Caption = 'Form5'
  ClientHeight = 168
  ClientWidth = 371
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 14
  object Label1: TLabel
    Left = 48
    Top = 32
    Width = 31
    Height = 13
    Caption = 'Label1'
  end
  object Button1: TButton
    Left = 48
    Top = 88
    Width = 249
    Height = 25
    Caption = 'Starte Thread'
    TabOrder = 0
    OnClick = Button1Click
  end
end

code:

Delphi-Quellcode:
unit Unit5;

interface

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

type
   TForm5 = class(TForm)
      Button1: TButton;
      Label1: TLabel;
      procedure Button1Click(Sender: TObject);
      procedure FormCreate(Sender: TObject);

   private
    { Private-Deklarationen }

      procedure StarteThread;
      procedure FinishTread(const Value: string);

   public
    { Public-Deklarationen }
   end;

var
   Form5: TForm5;

implementation

{$R *.dfm}

procedure TForm5.FormCreate(Sender: TObject);
begin
   Label1.Caption := '';
end;

procedure TForm5.Button1Click(Sender: TObject);
begin
   StarteThread;
end;

procedure TForm5.StarteThread;
Var temp : String;
begin
   Label1.Caption := 'Thread running';
   Button1.Enabled := False;
   TThread.CreateAnonymousThread(
      procedure
      begin
       try
         Sleep(5 * 1000); // Wait 5 secs
          temp := 'Ich habe fertig';
         // Oder halt Dein GetHttp
          //temp := GetHttp('wasauchimmer');


      // Und dem Mainthread mitteilen das wir etwas haben
      // Queue damit das erst passiert wenn der Mainthread wirklich Zeit hat.....
      if temp <> '' then
       TThread.Queue(nil,
            procedure
            begin
               FinishTread(temp);
            end);
       finally
           // Den Button wieder einschalten
          // Synchronize damit der Button sofort wieder enabled wird
         TThread.Synchronize(nil,
            procedure
            begin
               Button1.Enabled := true;
            end);
       end;

      end).Start;

end;

procedure TForm5.FinishTread(const Value: string);
begin
   Label1.Caption := Value;
end;

end.

KodeZwerg 4. Mai 2018 11:46

AW: TThread, irgendwas mache ich falsch
 
Hallo Fritzew, Danke für Dein Beispiel, das funktioniert bei mir leider nicht so, Whookie gab mir bereits ähnlichen Code.

So sieht jetzt eine Funktion aus:
Delphi-Quellcode:
function TFormMain.GetTHTTPClient ( Const xURL : String ) : String;
var
 tmp : String;
 MyThread: System.Classes.TThread;
begin
  tmp := '';
  CancelThread := False;
  MyThread := System.Classes.TThread.CreateAnonymousThread(
    procedure
    var
     HttpClient: System.Net.HttpClient.THttpClient;
     HttpResponse: System.Net.HttpClient.IHttpResponse;
    begin
      HttpClient := System.Net.HttpClient.THTTPClient.Create;
      try
        HttpClient.UserAgent := 'Mozilla/4.0 (compatible; MSIE 7.0; Windows; U; Windows NT 5.2; Trident/4.0; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30; en-US; rv:1.9.1.3) Gecko/20090824 Firefox/3.5.3 */*';
        HttpClient.MaxRedirects := 10;
        HttpClient.HandleRedirects := True;
        HttpClient.ContentType := '*/*';
        HttpClient.Accept := '*/*';
        HttpClient.ResponseTimeout := 5000;
        HttpClient.ConnectionTimeout := 5000;
        try
          HttpResponse := HttpClient.Get( xURL );
          tmp := HttpResponse.ContentAsString();
        except
          on e: System.SysUtils.Exception do
            tmp := 'Error Occured @ '+xURL+' - '+e.Message;
        end;
      finally
        HttpClient.Free;
      end;
    end
  );
  MyThread.FreeOnTerminate := True;
  MyThread.Start;
  repeat
    Vcl.Forms.Application.ProcessMessages;
    System.SysUtils.Sleep(5);
    if CancelThread then
    begin
      CancelThread := False;
      tmp := 'Download aborted.';
      if not Winapi.Windows.TerminateProcess(MyThread.Handle, 0) then MyThread.Terminate;
    end;
  until ((tmp <> '') or (Winapi.Windows.WaitForSingleObject(MyThread.Handle, 5) = Winapi.Windows.WAIT_FAILED)); //  WAIT_FAILED = DWORD($FFFFFFFF);
  if tmp = '' then tmp := 'Error Occured @ '+xURL;
  Result := tmp;
end;
Aufgerufen wird diese Funktion mit einem Millisekundenzähler, gestoppt wird Zähler wenn Funktion beendet:
Delphi-Quellcode:
 Watch := System.Diagnostics.TStopWatch.Create();
 Watch.Start;
 if System.Length(Temp1) > 0 then
 DataString := GetTHTTPClient( Temp1 ); // <<<--- hier rufe ich Thread auf und warte bis er fertig ist damit ich DataString habe und weiter machen kann
 Watch.Stop;
Bisher kann ich keine Probleme entdecken.

Fritzew 4. Mai 2018 12:12

AW: TThread, irgendwas mache ich falsch
 
Das Handling um den Thread abzubrechen ist, entschuldige bitte, nur Schrott.
Du kannst einen Thread nicht mit TerminateProcess beenden.
Ich verstehe nicht was dein Pollen da soll.
Aber es wurde eigentlich alles gesagt hier.
Meiner Meinung nach ist Dein Ansatz komplett falsch

himitsu 4. Mai 2018 14:46

AW: TThread, irgendwas mache ich falsch
 
Zitat:

Zitat von Fritzew (Beitrag 1401290)
Meiner Meinung nach ist Dein Ansatz komplett falsch

Ich nenne sowas fahrlässig.

Delphi-Quellcode:
MyThread.FreeOnTerminate := True;
MyThread.Start;
...
if TerminateProcess(MyThread.Handle, 0) then MyThread.Terminate;
Ab "..." darf von außen niewieder niemals nicht auf diese Variable zugegriffen werden!:!:

Denn wenn der Thread endet, wird das Objekt automatische gelöscht und ein Zugriff ist nicht mehr möglich.

Lösung: FreeOnTerminate:=False; und am Ende ein manuelles Free,
oder von innerhalb des Threads nach außen den Zustand in einer weiteren Variable/Event/Sonstwas speichern/informieren.


MSDN-Library durchsuchenTerminateProcess schießt den ganzen Prozess ab, also alle Threads, (rate mal, warum diese API so heißt, wie sie heißt)
aber da hier auch noch ein falsches Handle übergeben wurde, und der Entwickler fahrlässig nicht alle Rückgabewerte auswertet (GetLastError), bekommt er das nicht mit.

Man sagt dem Thread er soll sich beenden (Variable/Event, wie z.B. Delphi-Referenz durchsuchenTThread.Terminate) und innerhalb des Threads beendet dieser sich definiert/kontrolliert selber.

Und dass man Prozesse, abe vor allem Threads niemals hart abschießen darf, sollte jedem klar sein, wenn er endlich sich richtig mit Treads beschäftigen würde. (Tutorials gelesen und verstanden?)
Der Thread, bzw. die durch ihn verwalten Objekte/Speicher bleiben so in einem undefinierten Zustand und können den kompletten Prozess lahm legen,
wenn du den Thread abschießt, während er gerade beim Speichermanager etwas anfordert/freigibt, also z.B. zwischen dem Sperren und Freigeben einer CriticalSection, dann bleibt jene für immer gesperrt und auch andere Threads können nicht mehr ihren Speicher verwalten und bleiben somit hängen.


So, nun wurde aber wirklich schon alles mehrfach erwähnt und ich bin raus aus dem Thema.
Wünsche euch noch viel Spaß.

Fritzew 4. Mai 2018 15:12

AW: TThread, irgendwas mache ich falsch
 
Mein letzter Beitrag dazu...
himitsu hat vollkommen recht.


Hier noch mal eine abgewandelte Version:

Delphi-Quellcode:
procedure TForm5.StarteThread;
Var temp : String;
    Watch : TStopwatch;
begin
   Label1.Caption := 'Thread running';
   Button1.Enabled := False;
   Watch := TStopWatch.Create();
   Watch.Start;

   TThread.CreateAnonymousThread(
      procedure
      begin
       try
         Sleep(5 * 1000); // Wait 5 secs
          temp := 'Ich habe fertig';
         // Oder halt Dein GetHttp
          //temp := GetHttp('wasauchimmer');

       finally
         TThread.Synchronize(nil,
            procedure
            begin
              Watch.Stop;
               FinishTread(temp, Watch.ElapsedMilliseconds);
               Button1.Enabled := true;
            end);
       end;

      end).Start;

end;

procedure TForm5.FinishTread(const Value: string; const Millisecs : int64);
begin
   Label1.Caption := format('Message: %s time in Miilsecs %d',[Value, Millisecs]) ;
end;

KodeZwerg 4. Mai 2018 21:17

AW: TThread, irgendwas mache ich falsch
 
Ok Danke nochmal für die vielen Warnungen, ich hatte eh das falsche hier her kopiert,
Delphi-Quellcode:
if CancelThread then if not Winapi.Windows.TerminateThread(MyThread.Handle, 0) then MyThread.Terminate;
so war es.

Ich habe nun die zweite Code Variante erfolgreich umgesetzt

Hier mein jetziger Code:
Delphi-Quellcode:
procedure TFormMain.GetTHTTPClient ( Const xURL : String );
Var tmp : String;
    Watch : TStopwatch;
begin
  Watch := TStopWatch.Create();
  Watch.Start;
  TThread.CreateAnonymousThread(
   procedure
   var
     HttpClient: System.Net.HttpClient.THttpClient;
     HttpResponse: System.Net.HttpClient.IHttpResponse;
   begin
      HttpClient := System.Net.HttpClient.THTTPClient.Create;
      try
        HttpClient.UserAgent := 'Mozilla/4.0 (compatible; MSIE 7.0; Windows; U; Windows NT 5.2; Trident/4.0; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30; en-US; rv:1.9.1.3) Gecko/20090824 Firefox/3.5.3 */*';
        HttpClient.MaxRedirects := 10;
        HttpClient.HandleRedirects := True;
        HttpClient.ContentType := '*/*';
        HttpClient.Accept := '*/*';
        HttpClient.ResponseTimeout := 5000;
        HttpClient.ConnectionTimeout := 5000;
        try
          HttpResponse := HttpClient.Get( xURL );
          tmp := HttpResponse.ContentAsString();
        except
          on e: System.SysUtils.Exception do
            tmp := 'Error Occured @ '+xURL+' - '+e.Message;
        end;
      finally
        HttpClient.Free;
        TThread.Synchronize(nil,
         procedure
         begin
           Watch.Stop;
           FinishTread(xURL, tmp, Watch.ElapsedMilliseconds);
          end);
      end;
    end
  ).Start;
end;

procedure TFormMain.FinishTread( Const sUrl, sData: String; Const Millisecs : Int64 );
var
 i: Integer;
begin
  DataString := sData;
  if System.Length(DataString) > 0 then
  begin
    MemoText.Lines.Text := DataString;
    i := System.Length(MemoText.Lines.Text) ;
    MemoText.Lines.Add('');
    MemoText.Lines.Add('HTTP/S HTML Source from: '+sURL);
    if System.Length(DataString)-i < 0 then MemoText.Lines.Add('Downloaded: '+System.SysUtils.IntToStr(System.Length(DataString)) +' bytes, displaying: ' +System.SysUtils.IntToStr(i)+ ' chars. Additional added '+System.SysUtils.IntToStr(i-Length(DataString))+' extra Unicode bytes.');
    if System.Length(DataString)-i = 0 then MemoText.Lines.Add('Downloaded: '+System.SysUtils.IntToStr(System.Length(DataString)) +' bytes, displaying: ' +System.SysUtils.IntToStr(i)+ ' chars. Plain Ascii detected.');
    if System.Length(DataString)-i > 0 then MemoText.Lines.Add('Downloaded: '+System.SysUtils.IntToStr(System.Length(DataString)) +' bytes, displaying: ' +System.SysUtils.IntToStr(i)+ ' chars. Warning! '+System.SysUtils.IntToStr(System.Length(DataString)-i)+' bytes missing in Display!');
    if CheckBoxBenchmark.Checked then
    begin
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 1))and((ComboBoxByteCalc.ItemIndex = 0)or(ComboBoxByteCalc.ItemIndex = 1))) then
        MemoText.Lines.Add('Downloaded needed '+System.SysUtils.IntToStr(Millisecs)+' ms, that is '+System.SysUtils.FloatToStrF(Length(DataString) / (Millisecs / 1000), ffFixed, 35, 2)+' bytes/second <-> '+System.SysUtils.FloatToStrF((Length(DataString) / 1024) / (Millisecs / 1000), ffFixed, 35, 2)+' kbyte/s <-> '+System.SysUtils.FloatToStrF((Length(DataString) / 1024 / 1024) / (Millisecs / 1000), ffFixed, 35, 2)+' mbyte/s.');
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 2))and((ComboBoxByteCalc.ItemIndex = 0)or(ComboBoxByteCalc.ItemIndex = 1))) then
        MemoText.Lines.Add('Downloaded needed '+System.SysUtils.IntToStr(Millisecs)+' ms, that is '+System.SysUtils.FloatToStrF((Length(DataString)*8) / (Millisecs / 1000), ffFixed, 35, 2)+' bits/second <-> '+System.SysUtils.FloatToStrF(((Length(DataString)*8) / 1024) / (Millisecs / 1000), ffFixed, 35, 2)+' kbit/s <-> '+System.SysUtils.FloatToStrF(((Length(DataString)*8) / 1024 / 1024) / (Millisecs / 1000), ffFixed, 35, 2)+' mbit/s.');
      if ComboBoxByteCalc.ItemIndex = 0 then
        MemoText.Lines.Add('Above calculations based on 1024 byte = 1 kb for your pleasure 1000 byte = 1 kb follows.');
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 1))and((ComboBoxByteCalc.ItemIndex = 0)or(ComboBoxByteCalc.ItemIndex = 2))) then
        MemoText.Lines.Add('Downloaded needed '+System.SysUtils.IntToStr(Millisecs)+' ms, that is '+System.SysUtils.FloatToStrF(Length(DataString) / (Millisecs / 1000), ffFixed, 35, 2)+' bytes/second <-> '+System.SysUtils.FloatToStrF((Length(DataString) / 1000) / (Millisecs / 1000), ffFixed, 35, 2)+' kbyte/s <-> '+System.SysUtils.FloatToStrF((Length(DataString) / 1000 / 1000) / (Millisecs / 1000), ffFixed, 35, 2)+' mbyte/s.');
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 2))and((ComboBoxByteCalc.ItemIndex = 0)or(ComboBoxByteCalc.ItemIndex = 2))) then
      MemoText.Lines.Add('Downloaded needed '+System.SysUtils.IntToStr(Millisecs)+' ms, that is '+System.SysUtils.FloatToStrF((Length(DataString)*8) / (Millisecs / 1000), ffFixed, 35, 2)+' bits/second <-> '+System.SysUtils.FloatToStrF(((Length(DataString)*8) / 1000) / (Millisecs / 1000), ffFixed, 35, 2)+' kbit/s <-> '+System.SysUtils.FloatToStrF(((Length(DataString)*8) / 1000 / 1000) / (Millisecs / 1000), ffFixed, 35, 2)+' mbit/s.');
    end;
  end;
  ButtonDownload.Enabled := True;
end;

procedure TFormMain.ButtonDownloadClick(Sender: TObject);
begin
  ButtonDownload.Enabled := False;
  MemoText.Clear;
  MemoText.Lines.Add('Downloading Data from ' +Temp1);
  MemoText.Lines.Add('Please Wait...');
  GetTHTTPClient( 'https://www.google.com/' ); // hier startet nun der thread und macht sein ding bis er fertig ist.
end;
Danke sehr! Funktioniert soweit so gut, jetzt meine Frage, wie kann ich Download abbrechen?
Meine Methode mit einem Boolean als Trigger war ja die Falsche und erst recht der Befehl zum beenden.

p80286 4. Mai 2018 21:52

AW: TThread, irgendwas mache ich falsch
 
@Himitsu
Danke! in 13 Zeilen das wichtigste geschrieben und trotzdem, die meisten Tutorials eiern da nur herum.
Einem Thread gibt man alles notwendige mit und läßt ihn dann seine Aufgabe erledigen. Und wenn aus welchen Gründen auch immer, er zwischenzeitlich neue Instruktionen benötigt, dann hat der Programmierer ganz tolle Arbeit abgeliefert.
Das ist alles andere als simpel, und das macht man nicht im vorübergehen.

Gruß
K-H


Alle Zeitangaben in WEZ +1. Es ist jetzt 19:51 Uhr.
Seite 1 von 2  1 2      

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