program EXAMPLE3;

uses
  Crt,
  CoBase,
  CoEth01,
  CoINet,
  Http;


const Npaket = 17;

var citI:byte;

  procedure HttpErrorHandler( Session: PHttpSession;
    const AText: string ); far; forward;

  function HttpDataProvider( Session: PHttpSession ):
    Boolean; far; forward;

  function GetDocRoot( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean; far; forward;

  function GetDocPage1( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean; far; forward;


  {-------------------------------
  { HttpServer
  {---
  { Spusteni HTTP serveru,
  { procedura se ukonci po stisku klavesy
  {---
  }

  procedure HttpServer;
  var
    Status  : TCoStatus;
    HttpSvr : THttpServer;
  begin

    { Inicializace TCP/IP zasobniku }
    { Bazova adresa IOETH01 je $300 }
    { IP adresa a Maska je 192.168.1.200 a 255.255.255.0 }

{    Status := NetOpenStack( 'ETH01', 'IOBASE=$310',
      'IPADDR="146.102.39.2" NETMASK="255.255.248.0"', '' );
}
    Status := NetOpenStack( 'ETH01', 'IOBASE=$300',
      'IPADDR="192.168.1.200" NETMASK="255.255.248.0"', '' );

    if Status <> CST_SUCCESS then
    begin
      { Chyba pri inicializaci TCP/IP zasobniku }
      HttpErrorHandler( nil, 'NetOpenStack() failed: ' +
                             CoStatusToStr( Status ) );
      Exit;
    end;

    { Inicializace instance HTTP serveru }
    { Maximalni pocet soubeznych relaci je 2, maximalni velikost
      dotazu i odpovedi je 1024B }
    HttpSvr.Init( 2, '', 1024, 2048 );

    { Funkce poskytujici data serveru }
    HttpSvr.DataProvider := HttpDataProvider;

    { Funkce reagujici na chyby serveru }
    HttpSvr.ErrorHandler := HttpErrorHandler;

    { Periodicke tikani s HTTP serverem do stisku libovolne klavesy }

    repeat
      if KeyPressed then
      begin
        ReadKey;
        HttpSvr.Stop;
      end;
    until HttpSvr.Tick;

    { Uvolneni serveru z pameti }
    HttpSvr.Done;

    { Uvolneni TCP/IP zasobniku }
    NetCloseStack( '' );

  end;

  {-------------------------------
  { HttpErrorHandler
  {---
  { Funkce reagujici na chyby serveru
  {---
  { Tuto funkci si upravte podle potreby aplikace.
  }

  procedure HttpErrorHandler( Session: PHttpSession;
    const AText: string );
  begin
    if Session <> nil then
    begin
      WriteLn( 'Session: ', AText );
    end
    else begin
      WriteLn( 'Server: ', AText );
    end;
  end;

  {-------------------------------
  { HttpDataProvider
  {---
  { Funkce poskytujici data serveru
  {---
  { HttpDataProvider vola funkce, ktere poskytuji data
  { jednotlivych stranek
  }


  function HttpDataProvider( Session: PHttpSession ): Boolean;
  const
    Document: array[0..2] of THttpDispatchItem =
    (
      ( Segment: '';             Dispatcher: GetDocRoot  ),
      ( Segment: 'page1.html';   Dispatcher: GetDocPage1 ),
      ( Segment: nil;            Dispatcher: nil )
    );
  begin

    with Session^.Request do
    begin
      { Podle typu metody rozhodneme, kterou tabulku pouzijeme }

      case Method of

        mtdGET:
        begin
          HttpDataProvider := HttpDispatchSegment(
            Session^.Request.Path, @Document, Session );
        end;

      else
        { Nepodporovana metoda (jina nez GET) }
        with Session^.Response do
        begin
          StatusCode := HTE_METHOD_NOT_ALLOWED;
          { Odpoved je pripravena, nechame ji odeslat a tedy vratime True }
          HttpDataProvider := True;
        end;
      end;
    end;

  end;


  {-------------------------------
  { GetDocRoot
  {---
  { Vyplneni odpovedi na dotaz GET /
  {---
  }

  function GetDocRoot( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean;
  begin
    with ASession^.Response do
    begin
      StatusCode := HTE_OK;

      BeginEntity;
      with Content do
      begin
        Append( '<HTML>' );
        Append(   '<BODY>' );
        Append(     '<B>WWW Server - / (root) </B>' );
        Append(     '<P>Odkaz na stranku <A HREF="/page1.html">page1.html</A>' );
        Append(   '</BODY>' );
        Append( '</HTML>' );
      end;

      EndEntity;
    end;

    GetDocRoot := True;
  end;


  {-------------------------------
  { GetDocPage1
  {---
  { Vyplneni odpovedi na dotaz GET /page1.html
  {---
  }

  function GetDocPage1( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean;
  begin
    with ASession^.Response do
    begin
      StatusCode := HTE_OK;

      BeginEntity;
      with Content do
      begin
        Append( '<HTML>' );
        if BufferFull then RunError(255);
        Append(   '<BODY>' );
        if BufferFull then RunError(255);
        Append(     '<B>WWW Server - page1.html</B>' );
        if BufferFull then RunError(255);
        Append( '<BR>' );
        if BufferFull then RunError(255);

        for citI:=1 to Npaket do
         begin
           AppendInt( citI );
           if BufferFull then RunError(255);
           Append( ' - 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' );
           if BufferFull then RunError(255);
           Append( '<BR>' );
           if BufferFull then RunError(255);
         end;

        Append(   '</BODY>' );
        if BufferFull then RunError(255);
        Append( '</HTML>' );
        if BufferFull then RunError(255);
      end;

      EndEntity;
    end;

    GetDocPage1 := True;
  end;


{ Telo hlavniho programu }

begin
  ClrScr;
  HttpServer;
end.


