CODEWITHSUNDEEP
delphiindyidhttp
ar099968
ar099968

Reputation: 7537

Delphi IdHTTPServer (Indy 10.6): retrive some request/response info from TIdTCPConnection in OnWorkEnd event

It is possible retrieve some info (for logging purpose) from TIdTCPConnection when OnWorkEnd event is fired by TIdContext.Connection?

I want info like: - User ip-address (found my self in Socket.Binding.PeerIP) - Browser/client user agent - DateTime start request - Total size of request - Byte send - Filename of the file send

My server is very simple, on each request, response with a filestream.

procedure TMyHttpServer.OnCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
     AResponseInfo.ContentStream   := TFileStream.Create('C:\server\file.exe', fmOpenRead or fmShareDenyNone);
     AContext.Connection.OnWorkEnd := MyOnWorkEnd;
end;


procedure TMyHttpServer.MyOnWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
var
    aConnection : TIdTCPConnection;
    aIPAddress, aFileName, aDateStart, aByteSend, aFileSize, aUserAgent : string;
    aDateEnd   : TDateTime;
begin
    aConnection := TIdTCPConnection(ASender);

    aIPAddress := aConnection.Socket.Binding.PeerIP;

    aFileName  := ''; // Filename download 
    aDateStart := ''; // Date start download
    aDateEnd   := Now; 
    aByteSend  := ''; // byte send
    aFileSize  := ''; // file size
    aUserAgent := ''; // user agent

    WriteLog(aFileName  + ' ' + aDateStart +' '+aDateEnd +' etc.');

end;

Upvotes: 1

Views: 1789

Answers (1)

Remy Lebeau
Remy Lebeau

Reputation: 595320

The request and response info are not directly accessible in the OnWork... events. You will have to pass around the information manually. I would suggest either:

  1. Derive a new class from TFileStream to store the desired info, and then process the info in the class's destructor when the server frees the ContentStream after the response transfer is finished.

  2. Derive a new class from TIdServerContext to hold pointers to the TIdHTTPRequestInfo and TIdHTTPResponseInfo objects:

    type
  TMyContext = class(TIdServerContext)
  public
    Request: TIdHTTPRequestInfo;
    Response: TIdHTTPResponseInfo;
  end;

    Then you can assign that class type to the server's ContextClass property before activating the server, and typecast the AContext parameter in the OnCommandGet event to your class type so you can assign its pointers, and assign the AContext object to the AContext.Connection.Tag property:

    MyHttpServer.ContextClass := TMyContext;

...

procedure TMyHttpServer.OnCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  TMyContext(AContext).Request := ARequestInfo;
  TMyContext(AContext).Response := AResponseInfo;
  AContext.Connection.Tag := NativeInt(AContext);
  //...
end;

    In the OnWork... events, you can then type-cast the Sender parameter to reach its Tag, and type-cast that to your custom class to reach its stored request/response pointers:

    procedure TMyHttpServer.MyOnWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
var
  aConnection : TIdTCPConnection;
  aContext: TMyContext;
  //...
begin
  aConnection := TIdTCPConnection(ASender);
  aContext := TMyClass(aConnection.Tag);
  //...
end;

  3. A slight variation of #2 would be to manipulate the Self pointer of the OnWorkEnd event handler to pass the Context object directly to the handler without using the Connection.Tag property:

    type
  TMyContext = class(TIdServerContext)
  public
    Request: TIdHTTPRequestInfo;
    Response: TIdHTTPResponseInfo;
    MyServer: TMyHttpServer;
  end;

...

procedure TMyHttpServer.OnCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  Handler: TWorkEndEvent;
begin
  TMyContext(AContext).Request := ARequestInfo;
  TMyContext(AContext).Response := AResponseInfo;
  TMyContext(AContext).MyServer := Self;
  Handler := MyOnWorkEnd;
  TMethod(Handler).Data := TMyContext(AContext);
  AContext.Connection.OnWorkEnd := Handler
  //...
end;

procedure TMyHttpServer.MyOnWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
var
  aConnection : TIdTCPConnection;
  aContext: TMyContext;
  aServer: TMyHttpServer;
  //...
begin
  aConnection := TIdTCPConnection(ASender);
  aContext := TMyClass(Self);
  aServer := aContext. MyServer;
  //...
end;

Upvotes: 4

Related Questions