Witam,
jak umieścić kod serwera http w wątkach tak aby każde żądanie / lub żądania z danego IP odbywały się w osobnych wątkach.
Kod wątku (przykład):
unit Unit2;
interface
uses
Classes;
type
TMojWatek = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
implementation
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TMojWatek.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ TMojWatek }
procedure TMojWatek.Execute;
begin
{ Place thread code here }
end;
end.
Kod HTTPServer1CommandGet (przykład):
procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
LFilename: string;
LPathname: string;
Ext: string;
OldIdHttpSessionId: Variant;
Aout: array[0..5] of Variant;
begin
LFilename := ARequestInfo.Document; //Co chce dostać przeglądarka, jaki plik
if LFilename = '/' then
LFilename := '/index.htm';
LPathname := FHTMLDir + LFilename;
if FileExists(LPathname) or (LFilename = '/index.htm') then
begin
if LFilename = '/index.htm' then //Sprawdza czy plik istnieje wykonuje instrukcje tylko dla index.htm
begin
{sprawdzanie, logowanie}
Form1.memo1.Lines.Append(CheckParamValue(ARequestInfo,'userName'));
PGGetCookie(ARequestInfo, 'IDHTTPSESSIONID', OldIdHttpSessionId); //Odczytuje Cookie
loginMessage:=SetSessionToUser([CheckParamValue(ARequestInfo,'userName'),CheckParamValue(ARequestInfo,'userPass'),ARequestInfo.Session.SessionID, OldIdHttpSessionId]);
ARequestInfo.Params.SaveToStream(strumien);
ManageUserSession(AContext, ARequestInfo, AResponseInfo);
ServeVirtualFolder(AContext, ARequestInfo, AResponseInfo);
end;
if LFilename = '/index.htm0' then
begin
end
else
begin
AResponseInfo.ContentStream := TMemoryStream.Create();
t[CompareMSWithCS(LFilename)].Position:=0;
t[CompareMSWithCS(LFilename)].SaveToStream(AResponseInfo.ContentStream);
Ext:= y[CompareMSWithCS(LFilename)];
end;
if AResponseInfo.ContentStream <> nil then
begin
AResponseInfo.ResponseNo:= 200;
Ext:= y[CompareMSWithCS(LFilename)];
{ Wysyła Nagłówki Do Przeglądarki Aby Wiedziała Co Odbiera }
if AnsiEndsText('.jpg', Ext) then
begin
AResponseInfo.ContentType:= 'image/jpeg';
exit;
end;
if AnsiEndsText('.png', Ext) then
begin
AResponseInfo.ContentType:= 'image/png';
exit;
end;
if AnsiEndsText('.gif', Ext) then
begin
AResponseInfo.ContentType:= 'image/gif';
exit;
end;
if AnsiEndsText('.eot', Ext) then
begin
AResponseInfo.ContentType:= 'text/plain';
exit;
end;
if AnsiEndsText('.svg', Ext) then
begin
AResponseInfo.ContentType:= 'text/plain';
exit;
end;
if AnsiEndsText('.ttf', Ext) then
begin
AResponseInfo.ContentType:= 'text/plain';
exit;
end;
if AnsiEndsText('.woff', Ext) then
begin
AResponseInfo.ContentType:= 'text/plain';
exit;
end;
if AnsiEndsText('.js', Ext) then
begin
AResponseInfo.ContentType:= 'text/javascript';
exit;
end;
if AnsiEndsText('.css', Ext) then
begin
AResponseInfo.ContentType:= 'text/css';
exit;
end;
if AnsiEndsText('.html', Ext) then
begin
AResponseInfo.ContentType:= 'text/html';
exit;
end;
if AnsiEndsText('.htm', Ext) then
begin
AResponseInfo.ContentType:= 'text/html';
exit;
end;
end;
end;
AResponseInfo.ResponseNo:= 404;
end;
Jak np. tę procedurę TForm1.IdHTTPServer1CommandGet /i inne umieścić w TThread, nowe połączenie / wywołanie - nowy wątek.
Nadchodzi Request - tworzy się nowy wątek obsługujący TForm1.IdHTTPServer1CommandGet i inne procedury/funkcje mu potrzebne , wykonuje co ma wykonać odsyła co ma odesłać i wątek jest usuwany. Aktualnie jest taka sytuacja, że wiele zapytań w krótkim czasie zawiesza program lub wywala błędy, głównie z funkcjami/procedurami obsługującymi bazę danych/ oraz elementy wizualne serwera.