mORMot Open Source

procedure Run;
var
  HttpServer: TSQLHttpServer;
  Server: TSQLRestServerFullMemory;
  User: TSQLAuthUser;
  Group: TSQLAuthGroup;
  ServiceFactoryServer
    : TServiceFactoryServer;
  lSQLAccessRights: TSQLAccessRights;
  GroupID: TID;
begin
  Server := TSQLRestServerFullMemory.CreateWithOwnModel
    ([TSQLAuthUser, TSQLAuthGroup]);
  try
    Server.CreateMissingTables;
    ServiceFactoryServer := Server.ServiceDefine(TChatService, [IChatService],
      sicShared).SetOptions([], [optExecLockedPerInterface]);
    //thread-safe fConnected[]
    //.ByPassAuthentication := true;

    //=======================================================
    //Set Authentication
    //=======================================================
    Server.AuthenticationRegister
      (TSQLRestServerAuthenticationDefault);

    Server.Delete(TSQLAuthGroup, '');
    Group := TSQLAuthGroup.Create();
    Group.Ident := 'Client';
    lSQLAccessRights.AllowRemoteExecute := [reService];
    Group.SQLAccessRights := lSQLAccessRights;
    Group.SessionTimeout := 30;
    Server.Add(Group, True);
    Group.Free;

    Server.Delete(TSQLAuthUser, '');
    User := TSQLAuthUser.Create();
    User.DisplayName := 'client';
    User.LogonName := 'client';
    User.PasswordHashHexa := TSQLAuthUser.ComputeHashedPassword('ClientUser',
    'slat', 20000);

    GroupID := Server.MainFieldID(TSQLAuthGroup, 'Client');
    User.GroupRights := pointer(GroupID);
    Server.Add(User, True);
    User.Free;
    ServiceFactoryServer.AllowAll();
    //============================================================

    HttpServer := TSQLHttpServer.Create('8888', [Server], '+',
      useBidirSocket);
    try
      HttpServer.WebSocketsEnable(Server, PROJECT31_TRANSMISSION_KEY).
        Settings.SetFullLog; //full verbose logs for this demo
      TextColor(ccLightGreen);
      writeln('WebSockets Chat Server running on localhost:8888'#13#10);
      TextColor(ccWhite);
      writeln('Please compile and run Project31ChatClient.exe'#13#10);
      TextColor(ccLightGray);
      writeln('Press [Enter] to quit'#13#10);
      TextColor(ccCyan);
      readln;
    finally
      HttpServer.Free;
    end;
  finally
    Server.Free;
  end;
end;

procedure Run;
var
  Client: TSQLHttpClientWebsockets;
  pseudo, msg: string;
  Service: IChatService;
  callback: IChatCallback;
begin
  writeln('Connecting to the local Websockets server...');
  Client := TSQLHttpClientWebsockets.Create('127.0.0.1', '8888',
    TSQLModel.Create([TSQLAuthUser, TSQLAuthGroup]));
  try
    Client.Model.Owner := Client;
    Client.WebSocketsUpgrade(PROJECT31_TRANSMISSION_KEY);

    //Use Auth
    //==========================================================
    TSQLRestServerAuthenticationDefault.ClientSetUser(Client,
      'client', 'ClientUser', passClear, 'slat', 20000);
    //==========================================================

    if not Client.ServerTimeStampSynchronize then
      raise EServiceException.Create(
        'Error connecting to the server: please run Project31ChatServer.exe');
    Client.ServiceDefine([IChatService], sicShared);

    if not Client.Services.Resolve(IChatService, Service) then
      raise EServiceException.Create('Service IChatService unavailable');
    try
      TextColor(ccWhite);
      writeln('Please enter you name, then press [Enter] to join the chat');
      writeln('Enter a void line to quit');
      write('@');
      TextColor(ccLightGray);
      readln(pseudo);
      if pseudo = '' then
        exit;
      callback := TChatCallback.Create(Client, IChatCallback);
      Service.Join(pseudo, callback);
      TextColor(ccWhite);
      writeln('Please type a message, then press [Enter]');
      writeln('Enter a void line to quit');
      repeat
        TextColor(ccLightGray);
        write('>');
        readln(msg);
        if msg = '' then
          break;
        Service.BlaBla(pseudo, msg);
      until false;
    finally
      callback := nil; //will unsubscribe from the remote publisher
      //=======================================================================
      //sleep(1000); //Adding this, the server will execute the "CallbackReleased" event
      //=======================================================================
      Service := nil; //release the service local instance BEFORE Client.Free
    end;
  finally
    Client.Free;
  end;
end;

    finally
      callback := nil; //will unsubscribe from the remote publisher
      //=======================================================================
      sleep(1000); //Adding this, the server will execute the "CallbackReleased" event
      //=======================================================================
      Service := nil; //release the service local instance BEFORE Client.Free
    end;
  finally
    Client.Free;