RTC Forums

Using RTC v715, Delpi XE10
Have a project group with two projects.

project 1, win64, is form + RTCRestModule (datamodule) which has rtc components and code.
form creates datamodule, form click button does RTCRestModule.RtcHttpServer1.Listen();
browser does GET and application responds with JSON data as expected
TRtcHttpServer and TRtcDataProvider events fire and work as expected

project 2, win64, is consule app + same exact RTCRestModule  datamodule.
the "start" command does RTCRestModule.RtcHttpServer1.Listen(); (just like form)
TRtcHttpServer.OnListenStart fires as expected
browser does same GET request and hangs
No TRtcHttpServer and TRtcDataProvider events are fired.

What am I missing? Thanks, Jeff

TRtcHttpServer  has Multitreaded set to false


Code:
=========================
program rtcRESTserverConsuleApp;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  RTCWebRestUnit in 'RTCWebRestUnit.pas' {RTCRestModule: TDataModule};

procedure LogMessage(Msg: String);
begin
  WriteLn(Msg);
end;

var
  Command, ExePath, ConsoleAppName, RootDir: String;

begin
  try
    Command := '';
    ExePath := ParamStr(0);
    ConsoleAppName := ChangeFileExt(ExtractFileName(ExePath), '');
    RootDir := ExtractFileDir(ExePath);
    WriteLn(ConsoleAppName);
    RTCRestModule := TRTCRestModule.Create(nil);
    RTCRestModule.LogMessage := LogMessage;

    WriteLn('Waiting for command: Start, Exit');
    while True do begin
      if (Command = '') then
        ReadLn(Command);

      if (CompareText(Command, 'Exit') = 0) then begin
        if RTCRestModule.RtcHttpServer1.isListening then
          RTCRestModule.RtcHttpServer1.StopListen;
        Break;
      end;

      if (CompareText(Command, 'Start') = 0) then begin
        Command := '';
        RTCRestModule.RtcHttpServer1.Listen();
      end;

    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  FreeAndNil(RTCRestModule);

end.
=====================================
unit RESTserver_form;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TRESTserverForm = class(TForm)
    Panel1: TPanel;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  RESTserverForm: TRESTserverForm;

implementation

{$R *.dfm}

uses RTCWebRestUnit;

procedure LogMessage(Msg: String);
begin
  RESTserverForm.Memo1.Lines.Add(Msg);
end;

procedure TRESTserverForm.Button1Click(Sender: TObject);
begin
  LogMessage('START');
  RTCRestModule.RtcHttpServer1.Listen();
end;

procedure TRESTserverForm.Button2Click(Sender: TObject);
begin
  RTCRestModule.RtcHttpServer1.StopListen;
end;

procedure TRESTserverForm.FormCreate(Sender: TObject);
begin
  RTCRestModule := TRTCRestModule.Create(nil);
  RTCRestModule.LogMessage := LogMessage;
end;

procedure TRESTserverForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(RTCRestModule);
end;

end.
=====================================
unit RTCWebRestUnit;

interface

uses
  System.SysUtils, System.Classes, WinApi.Windows,
  rtcActiveX, rtcConn, rtcDataSrv, rtcHttpSrv, rtcInfo;

type
  TLogMessageNotifyEvent = procedure(Msg: String);
  TRTCRestModule = class(TDataModule)
    Controller_Ping: TRtcDataProvider;
    RtcHttpServer1: TRtcHttpServer;
    Controller_Favicon: TRtcDataProvider;
    procedure RtcHttpServer1ListenStart(Sender: TRtcConnection);
    procedure Controller_PingCheckRequest(Sender: TRtcConnection);
    procedure Controller_PingDataReceived(Sender: TRtcConnection);
    procedure RtcHttpServer1Connect(Sender: TRtcConnection);
    procedure RtcHttpServer1RequestNotAccepted(Sender: TRtcConnection);
    procedure RtcHttpServer1ClientConnect(Sender: TRtcConnection);
    procedure RtcHttpServer1ListenStop(Sender: TRtcConnection);
    procedure Controller_FaviconCheckRequest(Sender: TRtcConnection);
    procedure Controller_FaviconDataReceived(Sender: TRtcConnection);
  private
    { Private declarations }
  public
    { Public declarations }
    LogMessage: TLogMessageNotifyEvent;
  end;

var
  RTCRestModule: TRTCRestModule;

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

procedure TRTCRestModule.Controller_FaviconDataReceived(Sender: TRtcConnection);
var
  Srv:TRtcDataServer absolute Sender;
  RootDir, ExePath, FileName: String;
  f: THandle;
  size, sRead: Int64;
  Buffer: RtcByteArray;
begin
  if Srv.Request.Complete then begin
    Srv.Response.ContentType := 'image/x-icon';
    ExePath := ParamStr(0);
    RootDir := ExtractFileDir(ExePath);
    FileName := RootDir+'\favicon.ico';
    if (FileExists(FileName) = true) then begin
      f := FileOpen(FileName, fmOpenRead+fmShareDenyNone);
      if (f = INVALID_HANDLE_VALUE) then begin
        Srv.Response.Status(404,'File not found');
        Write('Status 404: File not found');
        Exit;
      end;
      Try
        size := FileSeek(f,int64(0),2); // 2 = The file pointer is positioned Offset bytes from the end of the file
        Srv.Response.ContentLength := size;
        SetLength(Buffer,Size);
        FileSeek(f,int64(0),int64(0));
        sRead := FileRead(f,Buffer[0],Size);
        if sRead<Size
          then SetLength(Buffer,sRead);
        Srv.Write(RtcBytesToString(Buffer));
      Finally
        FileClose(f);
      End;
    end else
      Srv.Write;
  end;
end;

procedure TRTCRestModule.Controller_PingCheckRequest(Sender: TRtcConnection);
var
  Srv:TRtcDataServer absolute Sender;
begin
  if (CompareText(Srv.Request.FileName, '/Ping') = 0) then
    Srv.Accept;
end;

procedure TRTCRestModule.Controller_PingDataReceived(Sender: TRtcConnection);
var
  Srv:TRtcDataServer absolute Sender;
  Result: TRtcRecord;
begin
  if Srv.Request.Complete then begin
    Result:=TRtcRecord.Create;
    Try
      Result.asBoolean['successful'] := true;
      Result.asText['message'] := 'OK';
      Result.asDateTime['Time'] := Now;
      Srv.WriteEx(Result.toJSONEx);
    Finally
      FreeAndNil(Result);
    End;
  end;
end;

procedure TRTCRestModule.Controller_FaviconCheckRequest(Sender: TRtcConnection);
var
  Srv:TRtcDataServer absolute Sender;
begin
  if (CompareText(Srv.Request.FileName, '/favicon.ico') = 0) then
    Srv.Accept;
end;

procedure TRTCRestModule.RtcHttpServer1ClientConnect(Sender: TRtcConnection);
begin
  LogMessage('Server.OnClientConnect');
end;

procedure TRTCRestModule.RtcHttpServer1Connect(Sender: TRtcConnection);
begin
  LogMessage('Server.OnConnect');
end;

procedure TRTCRestModule.RtcHttpServer1ListenStart(Sender: TRtcConnection);
begin
  if not Sender.inMainThread then
    Sender.Sync(RtcHttpServer1ListenStart)
  else begin
    LogMessage('Server is Listening on Port '+Sender.LocalPort);
    LogMessage('TreadID: ' + IntToStr(GetCurrentThreadId));
  end;
end;

procedure TRTCRestModule.RtcHttpServer1ListenStop(Sender: TRtcConnection);
begin
  if not Sender.inMainThread then
    Sender.Sync(RtcHttpServer1ListenStop)
  else begin
    LogMessage('Server Stopped Listening');
  end;
end;

procedure TRTCRestModule.RtcHttpServer1RequestNotAccepted(Sender: TRtcConnection);
var
  Srv:TRtcDataServer absolute Sender;
begin
  LogMessage('Server.RequestNotAccepted: ' + Srv.Request.FileName);
end;

end.

Console applications do not have a message queue, which is required for single-threaded async WinSock (used by default). To use RTC Server components in console Applications, you need to set the MultiThreaded property to TRUE, which creates a background thread with a message queue for handling messages. The same is true for Windows Service Applications.

For Client Applications, it would be enough to set the Blocking, useProxy or useWinHTTP property to TRUE, which would use Blocking WinSock, blocking WinInet or WinHTTP. But that doesn't work for a Server, which has to handle more than one connection.

Best Regards,
Danijel Tkalcec

Originally I had MultiThreading set to true, but had this problem:

OnListenStart fires with (not Sender.inMainThread = true) so Sender.Sync(RtcHttpServer1ListenStart) executes as expected.
But RtcHttpServer1ListenStart is never called a 2nd time, and does not respond to browser requests.

FYI, when I have this working I plan to create a windows service version of the application.

procedure TRTCRestModule.RtcHttpServer1ListenStart(Sender: TRtcConnection);
begin
  if not Sender.inMainThread then
    Sender.Sync(RtcHttpServer1ListenStart)
  else begin
    LogMessage('Server is Listening on Port '+Sender.LocalPort);
    LogMessage('TreadID: ' + IntToStr(GetCurrentThreadId));
  end;
end;

The Sync method does not work in Console Applications, because Console Applications do not have a message queue in the Main Thread. If you need your Server to run as a Console Application, you have to use the TRtcHttpServer component with MultiThreaded=True, write thread-safe code and forget about the "Sync" method.

Best Regards,
Danijel Tkalcec

Got it. Thanks!
It's working nicely now.