TThread, irgendwas mache ich falsch

[Zacherl]

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]

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]

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]

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]

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]

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]

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]

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]

Du wartest ja auch unendlich lange :roll:

Mach ein Timeout von wenigen Millisekunden und dann gehts auch.

[KodeZwerg]

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.