Un petit Proxy fait maison

Signaler
Messages postés
2
Date d'inscription
vendredi 23 janvier 2009
Statut
Membre
Dernière intervention
16 septembre 2011
-
 Utilisateur anonyme -
Bonjour,

Ce petit programme fonctionne comme un proxy.
Il utilise deux composants delphi: THttpserver de FPiette et TAlWinhttp de Alcinone.

Le premier prend les commandes GET et le second (multithread) fait le boulot d'aller chercher les données sur un proxy (S'occupe automatiquement des authentifications demandées NTLM, Negociate, ..).

J'ai un problème : un fois les données recueillies, au moment de répondre aux demandes des clients. La connexion s'interrompe : "Socket is not connected ..."

Quelqu'un a t-il une idée d'où peut provenir le problème ?

Code source :

unit uMain;

{$I OverbyteIcsDefs.inc}
{$IFNDEF DELPHI7_UP}
Bomb('This sample requires Delphi 7 or later');
{$ENDIF}
{$B-} { Enable partial boolean evaluation }
{$T-} { Untyped pointers }
{$X+} { Enable extended syntax }
{$I+} { Turn IO exceptions to on }
{$H+} { Use long strings }
{$J+} { Allow typed constant to be modified }
{$IFDEF COMPILER12_UP}
{ These are usefull for debugging !}
{$WARN IMPLICIT_STRING_CAST OFF}
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$WARN EXPLICIT_STRING_CAST OFF}
{$WARN EXPLICIT_STRING_CAST_LOSS OFF}
{$ENDIF}
{$WARN SYMBOL_PLATFORM OFF}
{$WARN SYMBOL_LIBRARY OFF}
{$WARN SYMBOL_DEPRECATED OFF}

{ 27 january 2001
Changed CloseDelayed to ShutDown(1) when a remote close. In some
circumstances there could be data not received by local socket when closed }

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,ComCtrls, ExtCtrls,
OverbyteIcsWSocketS, AlWinHttpClient, AlStringList, AlWinHttpWrapper,
OverbyteIcsWinSock, OverbyteIcsWndControl, OverbyteIcsWSocket,
OverbyteIcsHttpSrv, OverbyteIcsUtils, OverbyteIcsHttpAppServer, uLog,
NiceGrid, SyncObjs, HttpServerBroker;

const
WM_CLIENT_COUNT = WM_USER + 1;

type
{ This component is used for client connection instead of default one. }
{ This enables adding any data we need to handle our application. }
{ As this data is located in client component, each connected client has }
{ his own private data. }
TMyHttpConnection = class(THttpConnection)
protected
FPostedRawData : PAnsiChar; { Will hold dynamically allocated buffer }
FPostedDataBuffer : PChar; { Contains either Unicode or Ansi data }
FPostedDataSize : Integer; { Databuffer size }
FDataLen : Integer; { Keep track of received byte count. }
FDataFile : TextFile; { Used for datafile display }
FFileIsUtf8 : Boolean;
FClientNum : integer;
public
WSessionCookie : String;
destructor Destroy; override;
end;

type
TMain = class(TForm)
LocalPoort: TEdit;
ListenBtn: TButton;
StatusBar: TStatusBar;
Bevel1: TBevel;
Label1: TLabel;
StatusBar1: TStatusBar;
GroupBox7: TGroupBox;
CheckBoxInternetOption_BYPASS_PROXY_CACHE: TCheckBox;
CheckBoxInternetOption_ESCAPE_DISABLE: TCheckBox;
CheckBoxInternetOption_REFRESH: TCheckBox;
CheckBoxInternetOption_SECURE: TCheckBox;
CheckBoxInternetOption_ESCAPE_PERCENT: TCheckBox;
CheckBoxInternetOption_NULL_CODEPAGE: TCheckBox;
CheckBoxInternetOption_ESCAPE_DISABLE_QUERY: TCheckBox;
CheckBoxInternetOption_KEEP_CONNECTION: TCheckBox;
CheckBoxInternetOption_NO_COOKIES: TCheckBox;
CheckBoxInternetOption_NO_AUTO_REDIRECT: TCheckBox;
GroupBox3: TGroupBox;
Label18: TLabel;
Label19: TLabel;
EditUserName: TEdit;
EditPassword: TEdit;
GroupBox4: TGroupBox;
Label14: TLabel;
Label17: TLabel;
Label20: TLabel;
EditSendTimeout: TEdit;
EditReceiveTimeout: TEdit;
EditConnectTimeout: TEdit;
GroupBox6: TGroupBox;
RadioButtonProtocolVersion1_0: TRadioButton;
RadioButtonProtocolVersion1_1: TRadioButton;
GroupBox5: TGroupBox;
Label24: TLabel;
EditBufferUploadSize: TEdit;
GroupBox2: TGroupBox;
RadioButtonAccessType_NAMED_PROXY: TRadioButton;
RadioButtonAccessType_NO_PROXY: TRadioButton;
RadioButtonAccessType_DEFAULT_PROXY: TRadioButton;
GroupBox1: TGroupBox;
Label15: TLabel;
Label12: TLabel;
Label11: TLabel;
Label16: TLabel;
Label13: TLabel;
EdProxyPort: TEdit;
EdProxyUserName: TEdit;
EdProxyServer: TEdit;
EdProxyPassword: TEdit;
EdProxyBypass: TEdit;
GroupBox9: TGroupBox;
Label4: TLabel;
Label5: TLabel;
CheckBoxStopOnError: TCheckBox;
EditSendDelayBetweenEachSend: TEdit;
Label7: TLabel;
KeepAliveTimeSecEdit: TEdit;
Label8: TLabel;
MaxRequestsKeepAliveEdit: TEdit;
HttpServer1: THttpServer;
NiceGrid1: TNiceGrid;
CheckBoxReinitialiser: TCheckBox;
procedure ListenBtnClick(Sender: TObject);
procedure BgException(Sender: TObject; E: Exception; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure HttpServer1ServerStarted(Sender: TObject);
procedure HttpServer1ServerStopped(Sender: TObject);
procedure HttpServer1GetDocument(Sender, Client: TObject;
var Flags: THttpGetFlag);
procedure HttpServer1ClientConnect(Sender, Client: TObject;
Error: Word);
procedure HttpServer1ClientDisconnect(Sender, Client: TObject;
Error: Word);
procedure CheckBoxReinitialiserClick(Sender: TObject);
private
FInitialized : Boolean;
procedure initWinHTTP(aHttpClient: TAlWinHttpClient);
procedure Action(Sender: TObject; ClientCnx : TMyHttpConnection; var Flags : THttpGetFlag);
public
NBActiveThread: Integer;
StartTime: DWOrd;
ReqStartTime : DWord;
ToTalBytesReceived: Integer;
RequestHeaderRawHeaderText : string;
procedure Display(const HeaderMsg : string; const Msg : string; Num : integer);
procedure AppSrvBgException(Sender: TObject; E: Exception; var CanClose : Boolean);
protected
procedure WmClientCount(var Msg: TMessage); message WM_CLIENT_COUNT;
end;


TStressHttpThread = Class(Tthread)
private
fOn: Boolean;
FDownloadSpeedStartTime: DWord;
FBytesRead, FTotalRead: Integer;
fUrl: String;
fRequestCount: Integer;
FNumero : integer;
FRequestStatus: String;
FResponseContentHeader : string;
FBody: String;
//FMutex : THandle;
//FEvent : TEvent;
Procedure UpdateGUI;
Procedure EnvoyerPacket;
procedure OnTerminateProcedure(Sender : TObject);
protected
StopOnError: Boolean;
DoLikeaSpider: Boolean;
DelayBetweenEachCall: integer;
HttpClient: TalWinHttpClient;
Owner: TWinControl;
Client : TMyHttpConnection;
LstUrl: TAlAVLstringList;
MaxHttpRequest: Integer;
RequestHeaderClient: string;
Rank: integer;
procedure Execute; override;
procedure OnHttpDownloadProgress(sender: Tobject; Read: Integer; Total: Integer);
procedure OnHttpResponseHeaderAvalaible(sender: Tobject; ContentRepHeader : string; ReadHeader: Integer);
procedure OnHttpResponseBodyPartAvalaible(sender: Tobject; ContentRepBody : string; ReadBody: Integer);
Public
//FContentString : string;
ThreadTerminated : Boolean;
constructor Create(CreateSuspended: Boolean; AOwner: TwinControl; aRank: integer);
destructor Destroy; override;
End;

var
Main: TMain;
NbreRequest : integer;

DoSupprIfTerm : Boolean;
DisplayLock : TRTLCriticalSection;
EnvoiLock : TRTLCriticalSection;
implementation

uses
GpString,
XStrTool,
Math,
DateUtils,
ALMultiPartFormDataParser,
AlFcnFile,
AlFcnMisc,
AlfcnHtml,
AlFcnMime,
AlFcnString,
AlHttpCommon;

{$R *.DFM}

{**********************************************************}
procedure TMain.initWinHTTP(aHttpClient: TAlWinHttpClient);
Begin
With aHTTPClient do begin
UserName := EditUserName.Text;
Password := EditPassword.Text;

if AlIsInteger(EditConnectTimeout.Text) then ConnectTimeout := strtoint(EditConnectTimeout.Text);
if AlIsInteger(EditsendTimeout.Text) then SendTimeout := strtoint(EditSendTimeout.Text);
if AlIsInteger(EditReceiveTimeout.Text) then ReceiveTimeout := strtoint(EditReceiveTimeout.Text);

if RadioButtonProtocolVersion1_0.Checked then ProtocolVersion := HTTPpv_1_0
else ProtocolVersion := HTTPpv_1_1;

if AlIsInteger(EditBufferUploadSize.Text) then UploadBufferSize := strtoint(EditBufferUploadSize.Text);

ProxyParams.ProxyServer := EdProxyServer.Text;
ProxyParams.ProxyPort := strToInt(EdProxyPort.Text);
ProxyParams.ProxyUserName := EdProxyUserName.Text;
ProxyParams.ProxyPassword := EdProxyPassword.Text;
ProxyParams.ProxyBypass := EdProxyBypass.Text;

if RadioButtonAccessType_NO_PROXY.Checked then AccessType := wHttpAt_NO_PROXY
else if RadioButtonAccessType_NAMED_PROXY.Checked then AccessType := wHttpAt_NAMED_PROXY
else if RadioButtonAccessType_DEFAULT_PROXY.Checked then AccessType := wHttpAt_DEFAULT_PROXY;

InternetOptions := [];
If CheckBoxInternetOption_BYPASS_PROXY_CACHE.checked then InternetOptions := InternetOptions + [wHttpIo_BYPASS_PROXY_CACHE];
If CheckBoxInternetOption_ESCAPE_DISABLE.checked then InternetOptions := InternetOptions + [wHttpIo_ESCAPE_DISABLE];
If CheckBoxInternetOption_ESCAPE_DISABLE_QUERY.checked then InternetOptions := InternetOptions + [wHttpIo_ESCAPE_DISABLE_QUERY];
If CheckBoxInternetOption_ESCAPE_PERCENT.checked then InternetOptions := InternetOptions + [wHttpIo_ESCAPE_PERCENT];
If CheckBoxInternetOption_NULL_CODEPAGE.checked then InternetOptions := InternetOptions + [wHttpIo_NULL_CODEPAGE];
If CheckBoxInternetOption_REFRESH.checked then InternetOptions := InternetOptions + [wHttpIo_REFRESH];
If CheckBoxInternetOption_SECURE.checked then InternetOptions := InternetOptions + [wHttpIo_SECURE];
If CheckBoxInternetOption_NO_COOKIES.checked then InternetOptions := InternetOptions + [wHttpIo_NO_COOKIES];
If CheckBoxInternetOption_KEEP_CONNECTION.checked then InternetOptions := InternetOptions + [wHttpIo_KEEP_CONNECTION];
If CheckBoxInternetOption_NO_AUTO_REDIRECT.checked then InternetOptions := InternetOptions + [wHttpIo_NO_AUTO_REDIRECT];

RequestHeader.RawHeaderText := RequestHeaderRawHeaderText;
end;
end;

///////////////////////////////////////
////////// TStressHttpThread //////////
///////////////////////////////////////

{**************************************************************************************************}
constructor TStressHttpThread.Create(CreateSuspended: Boolean; AOwner: TWinControl; aRank: integer);
begin
FreeOnTerminate := True;
inherited Create(CreateSuspended);
//FMutex :=OpenMutex(MUTEX_ALL_ACCESS, True, 'MyProxyMutex');
//FEvent :=TEvent.Create(nil,False,False,'MyEvent');
fOn := True;
doLikeASpider := False;
DelayBetweenEachCall := 0;
Owner := AOwner;
HttpClient := TaLWinHttpClient.Create(nil);
with HttpClient do begin
AccessType := wHttpAt_NO_PROXY;
InternetOptions := [];
OnDownloadProgress := OnHttpDownloadProgress;
OnResponseHeaderAvalaible := OnHttpResponseHeaderAvalaible;
OnResponseBodyPartAvalaible := OnHttpResponseBodyPartAvalaible;
end;
LstUrl := TALAVLstringList.Create;
lstUrl.NameValueSeparator := #1;
FDownloadSpeedStartTime:= 0;
FBytesRead := 0;
FResponseContentHeader := '';
FBody := '';
MaxHttpRequest := 1;
Rank := aRank;
fUrl := '';
fRequestCount := 0;
FRequestStatus := '';
ThreadTerminated :=false;
OnTerminate := OnTerminateProcedure;
end;
{***********************************}
procedure TStressHttpThread.OnTerminateProcedure(Sender: TObject);
begin
ThreadTerminated :=true;
Synchronize(UpdateGUI);
end;
{***********************************}
destructor TStressHttpThread.Destroy;
begin
HttpClient.Free;
fOn := False;
Synchronize(UpdateGUI);
LstUrl.free;
inherited;
end;

procedure TMain.Display(const HeaderMsg : string; const Msg : string; Num : integer);
const aColor: array[1..14] of TColor = (clRed, clMaroon, clTeal, clMoneyGreen, clGreen, clAqua, clOlive, clNavy, clPurple, clLime, clYellow, clBlue, clFuchsia, clWhite);
begin
if csDestroying in ComponentState then Exit;
EnterCriticalSection(DisplayLock);
try
if Num <= high(aColor) then
Log.TextColor := aColor[Num]
else
Log.TextColor := clRed;
Log.Header := HeaderMsg;

Log.Add(Msg);
finally
LeaveCriticalSection(DisplayLock);
end;
end;

{**********************************}
procedure TStressHttpThread.Execute;
Var
aResponseContentHeader: TALHTTPResponseHeader;
aStartDate: TdateTime;
begin
if LstUrl.Count = 0 then
exit;
fUrl := LstUrl[random(LstUrl.Count)];
aStartDate := Now;
fUrl := AlStringReplace(FUrl,'<#ganalytics_utmn>',inttostr(int64(int64(1000000000) + int64(random(2147483647)) + int64(random(2147483647)) + int64(random(2147483647)) + int64(random(2147483647)))), [rfIgnoreCase]);
fUrl := AlStringReplace(FUrl,'<#ganalytics_utmhid>',inttostr(int64(int64(1000000000) + int64(random(2147483647)) + int64(random(2147483647)) + int64(random(2147483647)) + int64(random(2147483647)))), [rfIgnoreCase]);
fUrl := AlStringReplace(FUrl,'<#ganalytics_31bitrand>', inttostr(1 + random(2147483647)), [rfIgnoreCase]);
fUrl := AlStringReplace(FUrl,'<#ganalytics_timestamp>', inttostr(DateTimeToUnix(aStartDate)), [rfIgnoreCase, RfReplaceAll]);

inc(FRequestCount);
FDownloadSpeedStartTime := GetTickCount;
FBytesRead := 0;
try
aResponseContentHeader := TALHTTPResponseHeader.Create;
try
HttpClient.GetD(fUrl, aResponseContentHeader);
FRequestStatus := aResponseContentHeader.StatusCode;
finally
aResponseContentHeader.free;
end;
sleep(DelayBetweenEachCall);
Except
on e: Exception do begin
FRequestStatus := E.message;
Synchronize(UpdateGUI);
if StopOnError then begin
fOn := False;
Exit;
end;
end;
end;
Synchronize(UpdateGUI);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{****************************************************************************************}
procedure TStressHttpThread.OnHttpDownloadProgress(sender: Tobject; Read, Total: Integer);
begin
FBytesRead := Read;
FTotalRead := Total;
Synchronize(UpdateGUI);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{****************************************************************************************}
procedure TStressHttpThread.EnvoyerPacket;
begin
EnterCriticalSection(EnvoiLock);
try
if (FBody <> '') then
TMyHttpConnection(Client).SendStr(FBody);
if (FResponseContentHeader <> '') then
TMyHttpConnection(Client).SendStr(FResponseContentHeader);
finally
LeaveCriticalSection(EnvoiLock);
end;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{****************************************************************************************}
procedure TStressHttpThread.OnHttpResponseHeaderAvalaible(sender: Tobject; ContentRepHeader : string; ReadHeader: Integer);
begin
FResponseContentHeader := ContentRepHeader;
Synchronize(EnvoyerPacket);
Synchronize(UpdateGUI);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{****************************************************************************************}
procedure TStressHttpThread.OnHttpResponseBodyPartAvalaible(sender: Tobject; ContentRepBody : string; ReadBody: Integer);
begin
FBody := ContentRepBody;
Synchronize(EnvoyerPacket);
Synchronize(UpdateGUI);
end;

{************************************}
procedure TStressHttpThread.UpdateGUI;
Var timeElapsed: DWord;
RequestCount: Integer;
begin
TMain(Owner).NiceGrid1.BeginUpdate;
try
TMain(Owner).ToTalBytesReceived := TMain(Owner).ToTalBytesReceived + FBytesRead;
if not fOn then begin
dec(TMain(Owner).NBActiveThread);
TMain(Owner).StatusBar1.Panels[1].Text := inttostr(TMain(Owner).NBActiveThread);
TMain(Owner).NiceGrid1.cells[0, rank-1]:= inttostr(rank-1) + ' (off)';
if TMain(Owner).NBActiveThread = 0 then begin
timeElapsed := GetTickCount - TMain(Owner).StartTime;
RequestCount := NbreRequest;
TMain(Owner).StatusBar1.Panels[3].Text := inttostr(RequestCount) + ' Requests in ' + inttostr(round(timeElapsed / 1000)) + ' seconds (' + FormatFloat('0.##',RequestCount / (timeElapsed / 1000)) + ' Request/seconds | '+FormatFloat('0.##',(TMain(Owner).ToTalBytesReceived / 1000) / (timeElapsed / 1000))+' KB/seconds)';
end;
end;
TMain(Owner).NiceGrid1.cells[2, rank-1]:= fUrl;
TMain(Owner).NiceGrid1.cells[1, rank-1]:= inttostr(FRequestCount);
TMain(Owner).NiceGrid1.cells[3, rank-1]:= FRequestStatus;
TMain(Owner).NiceGrid1.cells[4, rank-1]:= inttostr(FBytesRead);
TMain(Owner).NiceGrid1.cells[5, rank-1]:= inttostr(FTotalRead);
TMain(Owner).NiceGrid1.cells[6, rank-1]:= Inttostr(Round((FBytesRead / 1000) / ((max(GetTickCount - FDownloadSpeedStartTime,1) / 1000)))) +' KB/s';
TMain(Owner).NiceGrid1.cells[7, rank-1] := inttostr(round((GetTickCount - TMain(Owner).ReqStartTime)/ 1000));
TMain(Owner).NiceGrid1.cells[8, rank-1] := booltostr(ThreadTerminated);;
if FResponseContentHeader <> '' then begin
TMain(Owner).Display('From remote' + #13#10 + 'Numero : ' + inttostr(FNumero) + #13#10 , FResponseContentHeader, FNumero);
FResponseContentHeader := '';
end;
if FBody <> '' then begin
TMain(Owner).Display('From remote' + #13#10 + 'Numero : ' + inttostr(FNumero)+ #13#10 , FBody, FNumero);
FBody := '';
end;
finally
TMain(Owner).NiceGrid1.EndUpdate;
end;
end;

//------------------------------------------------------------------------------
procedure TMain.ListenBtnClick(Sender: TObject);
begin
if ListenBtn.Tag = 0 then
begin
//if not FInitialized then begin
HttpServer1.Options := HttpServer1.Options - [hoAllowDirList];
HttpServer1.Options := HttpServer1.Options - [hoAllowOutsideRoot];

HttpServer1.Port := Trim(LocalPoort.Text);
HttpServer1.KeepAliveTimeSec := StrToIntDef(KeepAliveTimeSecEdit.Text, 10);
HttpServer1.MaxRequestsKeepAlive := StrToIntDef(MaxRequestsKeepAliveEdit.Text, 100);
HttpServer1.ClientClass := TMyHttpConnection;
try
HttpServer1.Start;
except
on E: Exception do
begin
Display('**** Unable to start server ****','', 1);
if HttpServer1.WSocketServer.LastError = WSAEADDRINUSE then
begin
Display('**** Port ' + HttpServer1.Port +
' already used by another application ****', '', 1);
Exit;
end;
Display('**** ' + E.ClassName + ': ' + E.Message + ' ****','', 1);
end;
end;
FInitialized := true;
LocalPoort.Enabled := False;
EdProxyport.Enabled := False;
EdProxyserver.Enabled := False;
ListenBtn.Caption := 'Cancel';
ListenBtn.Tag := 1;
//end
end else
begin
HttpServer1.Stop;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMain.action(Sender: TObject; ClientCnx : TMyHttpConnection; var Flags : THttpGetFlag);
Var
aStressHttpThread: TStressHttpThread;
begin
ReqStartTime := GetTickCount;
ToTalBytesReceived := 0;

if NbreRequest <= NiceGrid1.RowCount then
NiceGrid1.AddRow;

NiceGrid1.Cells[0,NbreRequest-1] := inttostr(NbreRequest) + ' (on)';

aStressHttpThread := TStressHttpThread.Create(True, self,NbreRequest);
initWinHTTP(aStressHttpThread.HttpClient);
aStressHttpThread.Client := TMyHttpConnection(ClientCnx);
aStressHttpThread.lstUrl.NameValueSeparator := #1;
aStressHttpThread.LstUrl.Add(ClientCnx.Path);
aStressHttpThread.MaxHttpRequest := 1;
aStressHttpThread.FreeOnTerminate := True;
aStressHttpThread.DoLikeaSpider := false;
aStressHttpThread.FNumero := NbreRequest;
aStressHttpThread.DelayBetweenEachCall := strtoint(EditSendDelayBetweenEachSend.text);
aStressHttpThread.StopOnError := CheckBoxStopOnError.Checked;
aStressHttpThread.Resume;
inc(NBActiveThread);

end;

//------------------------------------------------------------------------------
procedure TMain.BgException(Sender: TObject; E: Exception; var CanClose: Boolean);
begin
CanClose := True;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMain.FormCreate(Sender: TObject);
begin
NBActiveThread := 0;
DoSupprIfTerm := CheckBoxReinitialiser.Checked;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
HttpServer1.Stop;
HttpServer1.Free;
sleep(500);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMain.HttpServer1ServerStarted(Sender: TObject);
begin
Display('Waiting for client on port ' + HttpServer1.Port,'', 1);
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMain.AppSrvBgException(Sender: TObject; E: Exception; var CanClose : Boolean);
begin
Display('Exception processing page - ' + E.Message,'',1);
CanClose := true;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}


procedure TMain.HttpServer1ServerStopped(Sender: TObject);
begin
LocalPoort.Enabled := True;
EdProxyport.Enabled := True;
EdProxyserver.Enabled := True;
ListenBtn.Caption := 'Listen';
ListenBtn.Tag := 0;
Display('Server is now stopped','',1);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

procedure TMain.HttpServer1GetDocument(Sender, Client: TObject;
var Flags: THttpGetFlag);
begin
{ It's easyer to do the cast one time. Could use with clause... }
Flags := hgWillSendMySelf;
inc(NbreRequest);
if NbreRequest =1 then
StartTime := GetTickCount;
TMyHttpConnection(Client).FClientNum := NbreRequest;
Display('From Local' + #13#10 + 'Numero : ' + inttostr(NbreRequest) + #13#10 , TMyHttpConnection(Client).Method + ' ' +
TMyHttpConnection(Client).Path + #13#10 + TMyHttpConnection(Client).RequestHeader.Text, NbreRequest );
RequestHeaderRawHeaderText := TMyHttpConnection(Client).RequestHeader.Text;
Action(Sender, TMyHttpConnection(Client), Flags);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ We need to override parent class destructor because we have allocated }
{ memory for our data buffer. }
destructor TMyHttpConnection.Destroy;
begin
if Assigned(FPostedRawData) then begin
FreeMem(FPostedRawData, FPostedDataSize);
FPostedRawData := nil;
FPostedDataSize := 0;
end;
inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when a new client has connected. }
procedure TMain.HttpServer1ClientConnect(
Sender, { HTTP server component }
Client: TObject; { Client connecting }
Error: Word); { Error in connection }
begin
PostMessage(Handle, WM_CLIENT_COUNT, 0, 0);
StatusBar.Panels[1].Text := inttostr(HttpServer1.ClientCount);
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMain.WmClientCount(var Msg: TMessage);
begin
StatusBar.Panels[1].Text := inttostr(HttpServer1.ClientCount);
if (DoSupprIfTerm) and (HttpServer1.ClientCount = 0) then begin
Sleep(0);
NbreRequest:=0;
StatusBar1.Panels[1].Text := '0';
application.ProcessMessages;
NiceGrid1.Clear;
NiceGrid1.RowCount:=50;
NbreRequest:=0;
end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when a client is disconnecting, just }
{ before client component is closed. }
procedure TMain.HttpServer1ClientDisconnect(
Sender : TObject; { HTTP server component }
Client : TObject; { Client connecting }
Error : Word); { Error in disconnection }
begin
PostMessage(Handle, WM_CLIENT_COUNT, 0, 0);
Display('From Local - Deconnexion ' + #13#10 + 'Numero : ' + inttostr(TMyHttpConnection(Client).FClientNum) + #13#10 ,'', TMyHttpConnection(Client).FClientNum );
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMain.CheckBoxReinitialiserClick(Sender: TObject);
begin
DoSupprIfTerm := CheckBoxReinitialiser.Checked;
end;

{procedure TMain.Button1Click(Sender: TObject);
var
Event : TEvent;
begin
Event := TEvent.Create(nil,False,False,'MyEvent') ;
Event.SetEvent;
end;}

initialization
NbreRequest := 0;
InitializeCriticalSection(DisplayLock);
InitializeCriticalSection(EnvoiLock);
finalization
DeleteCriticalSection(DisplayLock);
DeleteCriticalSection(EnvoiLock);
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.

1 réponse


Salut,

Avant de poser ta question, as tu penser à lire la RFC du protocole HTTP

Dans cette RFC il y a marqué clairement :

Excepté pour des applications expérimentales, la pratique courante spécifie qu'une connexion doit être initiée par un client avant transmission de la requête, et refermée par le serveur après délivrance de la réponse. Les deux côtés, client et serveur, doivent être préparés à ce que la connexion soit coupée prématurément, suite à une action de l'utilisateur, une temporisation automatique, ou une faute logicielle, et doivent apporter une réponse prévisible à cette situation. Dans tous les cas, la fermeture d'une connexion qu'elle qu'en soit la raison est assimilable à la conclusion de la requête, quel que soit l'état.