Open a Text Editor of your choice, copy/paste the code below and save it as “MyHttpServer.dpr”.
program MyHttpServer; {$APPTYPE CONSOLE} uses SysUtils, rtcTypes, rtcSystem, rtcInfo, rtcConn, rtcDataSrv, rtcHttpSrv; type // This is our self-contained HTTP Server class ... TMyServer=class(TObject) protected HttpSrv:TRtcHttpServer; DataProv:TRtcDataProvider; public constructor Create(PortNumber:String='80'; IPVer:RtcIPV=rtc_IPVDefault); destructor Destroy; override; procedure DataProv_CheckRequest(Sender: TRtcConnection); procedure DataProv_DataReceived(Sender: TRtcConnection); procedure HttpSrv_ListenStart(Sender: TRtcConnection); procedure HttpSrv_ListenError(Sender: TRtcConnection; E:Exception); procedure HttpSrv_ListenStop(Sender: TRtcConnection); procedure HttpSrv_RequestNotAccepted(Sender: TRtcConnection); end; constructor TMyServer.Create(PortNumber:String='80'; IPVer:RtcIPV=rtc_IPVDefault); begin // Create HttpServer and DataProvider components ... HttpSrv:=TRtcHttpServer.Create(nil); DataProv:=TRtcDataProvider.Create(nil); // Assign Server for our Data Provider ... DataProv.Server:=HttpSrv; // Assign Data Provider Events (handles Valid Requests) ... DataProv.OnCheckRequest:=DataProv_CheckRequest; DataProv.OnDataReceived:=DataProv_DataReceived; // Assign Server Events (handles the rest) ... HttpSrv.OnRequestNotAccepted:=HttpSrv_RequestNotAccepted; HttpSrv.OnListenStart:=HttpSrv_ListenStart; HttpSrv.OnListenStop:=HttpSrv_ListenStop; HttpSrv.OnListenError:=HttpSrv_ListenError; // Configure the Server ... HttpSrv.ServerPort:=PortNumber; HttpSrv.ServerIPV:=IPVer; HttpSrv.MultiThreaded:=True; // Start the Server listener ... HttpSrv.Listen(); end; destructor TMyServer.Destroy; begin // Stop the Server listener ... HttpSrv.StopListenNow(); // Destroy the components ... HttpSrv.Free; DataProv.Free; end; procedure TMyServer.DataProv_CheckRequest(Sender: TRtcConnection); begin // Check Request headers and "Accept" all Requests // we want to handle with our Data Provider ... with TRtcDataServer(Sender) do if (Request.Method='GET') and // we only want "GET" requests (Request.ContentLength=0) then // ... with no content body if (Request.URI='/html') or (Request.URI='/json') or (Request.URI='/xml') or (Request.URI='/code') then Accept; // Accept the Request end; procedure TMyServer.DataProv_DataReceived(Sender: TRtcConnection); var t:TRtcRecord; begin with TRtcDataServer(Sender) do // We will start processing the request only if // we have received the complee request content body ... if Request.Complete then if Request.URI='/html' then begin // We can use multiple "Write" calls // to prepare our HTML response ... Response.ContentType:='text/html'; Write('<html><body>'); Write('Your IP: '+PeerAddr+'<br>'); Write('Your Port: '+PeerPort+'<br>'); Write('Date & Time: <b>'+DateTimeToStr(Now)+'</b><br>'); Write('Agent: <i>'+Request['User-Agent']+'</i><br>'); Write('</body></html>'); // All "Write" calls will be buffered, // RTC will calculate the "Content-Length" for us // and send the whole content body out as a single // Response - when we are finished with our event. end else begin // Using TRtcRecord to prepare our response Object ... t:=TRtcRecord.Create; try t.asText['agent']:=Request['User-Agent']; t.asText['ip']:=PeerAddr; t.asText['port']:=PeerPort; t.asDateTime['now']:=Now; if Request.URI='/json' then begin // Serialize to "JSON" ... Response.ContentType:='application/json'; Write(t.toJSON); end else if Request.URI='/xml' then begin // Serialize to "XML-RPC" ... Response.ContentType:='text/xml'; Write(t.toXMLrpc); end else if Request.URI='/code' then begin // Serialize to "Code" (RTC format) ... Response.ContentType:='text/plain'; Write(t.toCode); end; finally t.Free; end; end end; procedure TMyServer.HttpSrv_RequestNotAccepted(Sender: TRtcConnection); begin // Request wasn't accepted ... with TRtcDataServer(Sender) do begin // Send "404" status code back ... Response.Status(404,'Not Found'); Response.ContentType:='text/plain'; // Something to show in the Web Browser ... Write('Bad command.'); // And ... Disconnect the Client. Disconnect; end; end; procedure TMyServer.HttpSrv_ListenError(Sender: TRtcConnection; E: Exception); begin Writeln('Server Error: '+E.Message); end; procedure TMyServer.HttpSrv_ListenStart(Sender: TRtcConnection); begin Writeln('Server started.'); end; procedure TMyServer.HttpSrv_ListenStop(Sender: TRtcConnection); begin Writeln('Server stopped.'); end; var MyServer:TMyServer; begin try // Create and start our Server ... MyServer:=TMyServer.Create('80'); try // Since this is a console application and our // Server is Multi-Threaded, we can do whatever // we want here. For simplicity reasons, we will // just use "ReadLn" to allow the Server to run // while we wait for the user to press <Enter>. Writeln('Press <Enter> to Quit ...'); ReadLn; // User has pressed <Enter> - time to kill our Server. finally MyServer.Free; end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.