Einzelnen Beitrag anzeigen

Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.691 Beiträge
 
Delphi 11 Alexandria
 
#35

AW: TThread, irgendwas mache ich falsch

  Alt 4. Mai 2018, 12:46
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.
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat