mORMot2 Async Server Demo

Server.pas

unit IOServer;

interface

uses
  System.Classes,
  System.SysUtils,

  mormot.net.async,
  mormot.net.sock,

  mormot.core.base,
  mormot.core.buffers,
  mormot.core.rtti,
  mormot.core.threads,

  mormot.core.text,
  mormot.core.log;

type
  TNewConnection = class(TAsyncConnection)
  protected
    function OnLastOperationIdle(nowsec: TAsyncConnectionSec): boolean; override;
    function OnRead: TPollAsyncSocketOnReadWrite; override;
    procedure OnClose; override;
    procedure BeforeDestroy; override;
  end;

  TCServer = class(TAsyncServer)
  private
    LogFamily: TSynLogFamily;
  protected
    // creates TPostConnection and TRtspConnection instances for a given stream
    function ConnectionCreate(aSocket: TNetSocket; const aRemoteIp: RawUtf8;
      out aConnection: TAsyncConnection): boolean; override;
  public
    constructor Create(const aTCPPort: RawUtf8); reintroduce;
    /// shutdown and finalize the server
    destructor Destroy; override;
  end;

function StartNewServer(Port: RawUtf8): TCServer;

implementation

uses
  MainForm;

function StartNewServer(Port: RawUtf8): TCServer;
begin
  try
    Result := TCServer.Create(Port);
  except
    raise;
  end;
  // Add to list view
  fMain.UpdateOpenPorts(String(Result.Server.Port));
end;

{ TCServer }

function TCServer.ConnectionCreate(aSocket: TNetSocket; const aRemoteIp: RawUtf8; out aConnection: TAsyncConnection): boolean;
var
  log: ISynLog;
begin
  if Terminated then
    Exit(False);

  log := fLog.Enter('ConnectionCreate(%)', [PtrUInt(aSocket)], self);

  aConnection := nil;

  aConnection := TNewConnection.Create(self, aRemoteIp);
  if not inherited ConnectionAdd(aSocket, aConnection) then
  begin
    FreeAndNilSafe(aConnection);
    log.log(sllError, 'inherited %.ConnectionAdd(%) failed', [PtrUInt(aSocket)], self);
    Exit(False);
  end;

  WriteString(aConnection, 'WELCOME');
  Result := True;
end;

constructor TCServer.Create(const aTCPPort: RawUtf8);
begin
  LogFamily := TSynLog.Family;
  LogFamily.Level := LOG_VERBOSE;
  LogFamily.PerThreadLog := ptIdentifiedInOnFile;
  LogFamily.EchoToConsole := LOG_VERBOSE;

  self.LastOperationIdleSeconds := 10; // To Enable OnLastOperationIdle callback

  inherited Create(aTCPPort, nil, nil, TNewConnection, UTF8String(TCServer.ClassName), LogFamily.SynLogClass, [acoVerboseLog], 15);
end;

destructor TCServer.Destroy;
begin
  // TODO: Free Any related Memory that we create
  inherited Destroy;
end;

{ TNewConnection }

procedure TNewConnection.BeforeDestroy;
begin
  // TODO : Remove All Child Sockets Related to the Main Socket
  Owner.log.Add.log(sllWarning, 'BeforeDestroy - %', [self], Owner);
  inherited BeforeDestroy;
end;

procedure TNewConnection.OnClose;
begin
  // TODO: Close all related Connections and Remove node from MainList.
  Owner.log.Add.log(sllWarning, 'OnClose - %', [self], Owner);
end;

function TNewConnection.OnLastOperationIdle
  (nowsec: TAsyncConnectionSec): boolean;
begin
  Owner.WriteString(self, 'HI_Client');
  Owner.log.Add.log(sllServer, 'Send HeartBeat to %',[Handle], self);
  Result := False;
end;

function TNewConnection.OnRead: TPollAsyncSocketOnReadWrite;
begin
  Result := soContinue;
  // Echo what we receive.
  Owner.Write(self, fRd.Buffer, fRd.Len);
  Owner.log.Add.log(sllClient, 'OnRead % Received Data Len [%]', [Handle, fRd.Len], self);
  fRd.Reset;
end;

end.