TThread, irgendwas mache ich falsch

[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.

[KodeZwerg]

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]

Delphi-Quellcode:

Sleep(5);
  until WaitForSingleObject(MyThread.Handle, 5)

Ein paar Dinge verstehen könntest du dennoch lernen

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.
> Delay etwas anpassen

[Whookie]

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]

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]

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]

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