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

Question

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;

Answer 1

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;