Hallo,
Das Problem wurde leider immer noch nicht gelöst
Es wird ein IdHTTPServer betrieben.
Im OnGet kommen z.B. Bestellungen rein, die z.B. einen Bondruck mittels FastReport anstoßen.
Weil sich der Fastreport aktuell auf einem Form der
GUI befindet, darf immer nur ein OnGet einzeln abgearbeitet werden.
Also alle OnGet-Ereignisse (insbesondere die Funktion ANTWORTEN_ERZEUGEN) sollen NACHEINANDER abgearbeitet werden.
Wenn ein OnGet durch eine Anfrage ausgelöst wird, und gerade schon ein anderer Thread die Funktion ANTWORTEN_ERZEUGEN abarbeitet, dann soll der neue OnGet-Thread VOR ANTWORTEN_ERZEUGEN warten und die Funktion ANTWORTEN_ERZEUGEN erst beginnen, wenn die Funktion in dem anderen Thread VOLLSTÄNDIG abgearbeitet ist.
Untenstehend ist der Code zu sehen, mit dem ich das versucht habe. Aber es funktioniert irgendwie nicht.
Mein Eindruck ist, dass ein Thread aus der Funktion ANTWORTEN_ERZEUGEN rausspringt bzw fertig ist, obwohl der Druck und/oder die Abarbeitung (z.B. Filtern von Tables und Schleifen durch die Tables) gerade noch stattfindet.
Hat jemand zufällig einen Vorschlag, wie man das Problem lösen kann? Mir gehen allmählich die Ideen aus. Falls das eine Rolle spielt: Es wird Firemonkey genutzt.
Die Ausgaben "Deadlock detected" und "DoubleGet detected" erscheinen ab und zu beide. Wenn ein Client ab und zu mal ein paar Sekunden warten muss wegen der seriellen Abarbeitung wäre das nicht weiter schlimm.
Markus
Code:
procedure TfrmMain.HTTPServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
try
GUI_Lock_Starten_oder_Warten;
TThread.Synchronize(nil,
procedure
begin
ANTWORTEN_ERZEUGEN(AContext, ARequestInfo, AResponseInfo); // -> AResponseInfo.ContentText
end
);
GUI_Lock_Aufheben;
except
on e:
exception do
begin
AResponseInfo.ContentText := 'Systemfehlermeldung vom Server: ' + e.Message;
end;
end;
end;
procedure TfrmMain.GUI_Lock_Starten_oder_Warten;
var SperreAktiv : Boolean;
warten : integer;
begin
try
SperreAktiv := True;
while SperreAktiv do
begin
try
if not HTTP_is_working
then begin
SperreAktiv := False;
end else begin
try
ButtonDeadlock2.Text := 'DoubleGet detected at ' + DateTimeToStr(Now);
except
on
exception do begin end;
end;
end;
except
on e:
exception do begin end;
end;
warten := RandomRange(150,300);
Sleep(warten);
end; // while
HTTP_is_working := True;
HTTP_is_working_last_Start := Now;
except
on e:
exception do begin end;
end;
end;
procedure TfrmMain.GUI_Lock_Aufheben;
begin
try
HTTP_is_working := False;
except
on e:
exception do begin end;
end;
end;
procedure TfrmMain.Timer_HTTP_Deadlock_Timeout_prüfenTimer(Sender: TObject);
begin
try
if HTTP_is_working then
begin
if (Abs(SecondsBetween(HTTP_is_working_last_Start,Now)) > 7)
then begin
HTTP_is_working := False; // Deadlock übergehen
try
ButtonDeadlock.Text := 'Deadlock detected at ' + DateTimeToStr(Now);
except
on e:
exception do begin end;
end;
end;
end;
except
on e:
exception do begin end;
end;
end;