Monthly Archives: January 2017

RTC HTTP Server in 199 lines of code

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.

Continue reading