Ciao Diego.
"TServerThrd" mi fa pensare che il "main" sia dentro un thread.
Il serverino che ho scritto ha come classe padre TCustomApplication.
TWebApplication = class(TCustomApplication)
private
fContainer: TContainer;
FPort: integer;
FSocket: TTCPBlockSocket;
function GetBaseDir: string;
function GetDefaultIndex: string;
procedure SetBaseDir(AValue: string);
procedure SetDefaultIndex(AValue: string);
procedure SetPort(AValue: integer);
protected
procedure DoRun; override;
public
procedure Initialize; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Port: integer read FPort write SetPort;
property BaseDir: string read GetBaseDir write SetBaseDir;
property DefaultIndex: string read GetDefaultIndex write SetDefaultIndex;
property Environment: TContainer read fContainer;
end;
TWebDelegateThread = class(TThread)
procedure TWebApplication.DoRun;
var
ClientSock: TSocket;
begin
with FSocket do
begin
CreateSocket;
setLinger(True, 10000);
bind('0.0.0.0', IntToStr(FPort));
listen;
while not Terminated do
begin
if canread(1000) then
begin
ClientSock := accept;
if lastError = 0 then
begin
TWebDelegateThread.Create(ClientSock, fContainer);
end;
end;
end;
end;
end;
Per l'index di test:
<html>
<head>
</head>
<body>
<script>
window.open(location.href,'_blank');
</script>
</body>
</html>
Il server non ha problemi.
Il browser martella il server di richieste e ad ogni richiesta viene sganciato un thread, questo cerca il file e lo invia. Nel frattempo si fa una serie di giri mentali.
La differenza, credo, sta nel fatto che non apro un thread che sgancia altre thread?
Nota:
Sono partito dall'esempio che menzionavi. Forse è il test che è faccio a non essere così stressante come il tuo.
Stilgar
Ciao
Piccolo eseguibile che scarica 100 thread alla ricerca di una pagina.
Giusto per vedere se crolla il serverino ;)
program StressTest;
{$mode objfpc}{$H+}
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
cthreads, {$ENDIF} {$ENDIF}
Classes,
CustApp,
httpsend,
SysUtils;
type
{ TConnectionThread }
TConnectionThread = class(TThread)
procedure Execute; override;
end;
{ TStressTest }
TStressTest = class(TCustomApplication)
protected
FClients: array[0..99] of TConnectionThread;
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
{ TConnectionThread }
procedure TConnectionThread.Execute;
var
r: TStringList;
begin
r := TStringList.Create;
Write('Server response');
Writeln(HttpGetText('http://localhost:8081', r));
r.Free;
Terminate;
end;
{ TStressTest }
procedure TStressTest.DoRun;
var
t: TConnectionThread;
begin
Writeln('Executing ', Length(FClients), ' Connection Request');
for t in FClients do
begin
t.Start;
end;
Writeln('Done ', Length(FClients), ' Connection Request');
Terminate;
end;
constructor TStressTest.Create(TheOwner: TComponent);
var
t: TConnectionThread;
i: integer;
begin
inherited Create(TheOwner);
StopOnException := True;
for i := Low(FClients) to High(FClients) do
begin
T := TConnectionThread.Create(True);
FClients[i] := T;
end;
Writeln('Prepared ', Length(FClients), ' connection client for test');
end;
destructor TStressTest.Destroy;
var
T: TConnectionThread;
begin
for t in FClients do
begin
t.Free;
end;
inherited Destroy;
end;
procedure TStressTest.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ', ExeName, ' -h');
end;
var
Application: TStressTest;
begin
Application := TStressTest.Create(nil);
Application.Initialize;
Application.Title := 'ServerStressTest';
Application.Run;
Application.Free;
end.
program StressTest;
{$mode objfpc}{$H+}
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
cthreads, {$ENDIF} {$ENDIF}
Classes,
CustApp,
httpsend,
SysUtils;
type
TTestCallback = procedure(Result: boolean) of object;
{ TConnectionThread }
TConnectionThread = class(TThread)
private
FTestCallback: TTestCallback;
FUrl: string;
procedure SetTestCallback(AValue: TTestCallback);
procedure SetUrl(AValue: string);
public
procedure Execute; override;
property TestCallback: TTestCallback read FTestCallback write SetTestCallback;
property Url: string read FUrl write SetUrl;
end;
{ TStressTest }
TStressTest = class(TCustomApplication)
protected
FTestCount: integer;
FClients: array[0..99] of TConnectionThread;
procedure DoRun; override;
procedure TestCallback(Result: boolean);
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
{ TConnectionThread }
procedure TConnectionThread.Execute;
var
r: TStringList;
begin
r := TStringList.Create;
if Assigned(FTestCallback) then
begin
FTestCallback(HttpGetText(FUrl, r));
end
else
begin
HttpGetText(FUrl, r);
end;
r.Free;
Terminate;
end;
procedure TConnectionThread.SetTestCallback(AValue: TTestCallback);
begin
if FTestCallback = AValue then
begin
Exit;
end;
FTestCallback := AValue;
end;
procedure TConnectionThread.SetUrl(AValue: string);
begin
if FUrl = AValue then
begin
Exit;
end;
FUrl := AValue;
end;
{ TStressTest }
procedure TStressTest.DoRun;
var
t: TConnectionThread;
testUrl: string;
begin
testUrl := 'http://localhost:8081';
if ParamCount > 0 then
begin
testUrl := Params[1];
end;
for t in FClients do
begin
t.Url := testUrl;
t.TestCallback := @TestCallback;
end;
Writeln('Executing ', Length(FClients), ' Connection Request');
for t in FClients do
begin
t.Start;
end;
Writeln('Done ', Length(FClients), ' Connection Request');
Terminate;
end;
procedure TStressTest.TestCallback(Result: boolean);
var
cs: TRTLCriticalSection;
begin
TryEnterCriticalsection(cs);
if (Result) then
begin
Inc(FTestCount);
Writeln('Completed test ok: ', FTestCount);
end;
LeaveCriticalsection(cs);
end;
constructor TStressTest.Create(TheOwner: TComponent);
var
t: TConnectionThread;
i: integer;
begin
inherited Create(TheOwner);
StopOnException := True;
for i := Low(FClients) to High(FClients) do
begin
T := TConnectionThread.Create(True);
FClients[i] := T;
end;
Writeln('Prepared ', Length(FClients), ' connection client for test');
end;
destructor TStressTest.Destroy;
var
T: TConnectionThread;
begin
for t in FClients do
begin
t.Free;
end;
inherited Destroy;
end;
procedure TStressTest.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ', ExeName, ' -h');
end;
var
Application: TStressTest;
begin
Application := TStressTest.Create(nil);
Application.Initialize;
Application.Title := 'ServerStressTest';
Application.Run;
Application.Free;
end.