![]() |
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:
edit
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; 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. |
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. |
AW: TThread, irgendwas mache ich falsch
Durch die Zeile
Delphi-Quellcode:
nach .Start; hebst du die Wirkung des Threads wieder komplett auf.
repeat sleep(5) until not threadrun;
|
AW: TThread, irgendwas mache ich falsch
Moin...:P
Ich weiß nicht wie weit du drinsteckst...es hilft vieleicht (TThread Grundlagen): ![]() |
AW: TThread, irgendwas mache ich falsch
Wäre dafür nicht das Konzept Futures aus der Delphi Parallel Library. Schau mal unter:
![]() ![]() |
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.
|
AW: TThread, irgendwas mache ich falsch
Zitat:
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. |
AW: TThread, irgendwas mache ich falsch
Zitat:
Gruß K-H |
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. |
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:
Geht leider nicht...
Procedure Button1Click(Sender : TObject);
begin MachWaslangesImThread; IchWarteHiersolangenonBlocking; end; 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:
Wird zwar dadurch nicht schneller, aber die Oberfläche bleibt reaktiv.
Procedure Button1Click(Sender : TObject);
begin ShowWait; MachWaslangesImThreadAsync(Procedure (Data : TData) begin IcharbeitemitdemErgebnis(Data); HideWait; end); end; 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:
Nur mal so als Anregungen.
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; Mavarik :coder: |
AW: TThread, irgendwas mache ich falsch
Zitat:
Edit: ![]() |
AW: TThread, irgendwas mache ich falsch
Zitat:
Gruß K-H |
AW: TThread, irgendwas mache ich falsch
Tut sich nicht jeder am Anfang schwer wenn er in Parallelprogrammierung einsteigt? Ich habe selbst derzeit
![]() 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. |
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:
Das mit Future ist die falsche Richtung, Danke für die Hinweise @mehrere edit
Code:
Das teste ich gerade als Ersatz für die repeat Schleife aber Programm friert immer noch ein.
WaitForSingleObject(MyThread.Handle, INFINITE);
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; |
AW: TThread, irgendwas mache ich falsch
Zitat:
Code:
Wenn Machwas zeitaufwendig ist, dann macht das Programm den Eindruck eingefroren zu sein.
repeat
GibtesMessages; verarbeiteMessages; Gibtes Events; VerarbeiteEvents; // ab hier meine Erweiterungen Machwas; until terminated; 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 |
AW: TThread, irgendwas mache ich falsch
Zitat:
Zitat:
> Mach was und wenn fertig gib es mir. Zitat:
|
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:
Natürlich muss es dann noch einen entsprechenden Label geben, oder man macht mit Data was immer man möchte... :wink: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; |
AW: TThread, irgendwas mache ich falsch
Delphi-Quellcode:
scheint auch nicht zu helfen.
while WaitForSingleObject(MyThread.Handle, INFINITE) = WAIT_OBJECT_0 do Application.ProcessMessages;
@Whookie: Ich verstehe zwar wie Du es meinst aber kann es so noch nicht praktikabel umsetzen. |
AW: TThread, irgendwas mache ich falsch
Du wartest ja auch unendlich lange :roll:
Mach ein Timeout von wenigen Millisekunden und dann gehts auch. |
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. |
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:
Das Programm kann man weiterhin bedienen, nichts friert ein.
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; Danke für alle Hinweise und Tipps! |
AW: TThread, irgendwas mache ich falsch
Delphi-Quellcode:
Ein paar Dinge verstehen könntest du dennoch lernen :zwinker:
Sleep(5);
until WaitForSingleObject(MyThread.Handle, 5) 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. > ![]() |
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. |
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.
|
AW: TThread, irgendwas mache ich falsch
Delphi-Quellcode:
So sieht es aktuell aus, Abbruch-Bedingung ist ein Globales Boolean, gesteuert über Knopf.
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; Momentan klappt allerdings irgendwie gar nichts so richtig. Das mit den Sleep(5) ist irgendwie ein Automatismus bei mir, sobald ich ProcessMessages aufrufe. |
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). |
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. |
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; |
AW: TThread, irgendwas mache ich falsch
Delphi-Quellcode:
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:
until ((tmp <> '') or (WaitForSingleObject(MyThread.Handle, 5) = WAIT_FAILED));
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:
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.
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; Was haltet Ihr davon? |
AW: TThread, irgendwas mache ich falsch
Bitte niemals auf das Handle eines Threads mit
Delphi-Quellcode:
warten!
FreeOnTerminate := True
An der Stelle, wo das Warten passiert, kann der Thread schon durchgelaufen und weg sein. |
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? |
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... |
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; |
AW: TThread, irgendwas mache ich falsch
Um Himmels willen........
Delphi-Quellcode:
Das ist jetzt aber nur noch falsch, schau mal in die Docu von TerminateProcess
//bzw jetzt die Friss oder Stirb methode
if not Winapi.Windows.TerminateProcess(MyThread.Handle, 0) then MyThread.Terminate; ![]() 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. |
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:
Aufgerufen wird diese Funktion mit einem Millisekundenzähler, gestoppt wird Zähler wenn Funktion beendet:
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;
Delphi-Quellcode:
Bisher kann ich keine Probleme entdecken.
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; |
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 |
AW: TThread, irgendwas mache ich falsch
Zitat:
Delphi-Quellcode:
Ab "..." darf von außen niewieder niemals nicht auf diese Variable zugegriffen werden!:!:
MyThread.FreeOnTerminate := True;
MyThread.Start; ... if TerminateProcess(MyThread.Handle, 0) then MyThread.Terminate; 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. ![]() 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. ![]() 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ß. |
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; |
AW: TThread, irgendwas mache ich falsch
Ok Danke nochmal für die vielen Warnungen, ich hatte eh das falsche hier her kopiert,
Delphi-Quellcode:
so war es.
if CancelThread then if not Winapi.Windows.TerminateThread(MyThread.Handle, 0) then MyThread.Terminate;
Ich habe nun die zweite Code Variante erfolgreich umgesetzt Hier mein jetziger Code:
Delphi-Quellcode:
Danke sehr! Funktioniert soweit so gut, jetzt meine Frage, wie kann ich Download abbrechen?
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; Meine Methode mit einem Boolean als Trigger war ja die Falsche und erst recht der Befehl zum beenden. |
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 16:22 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz