jeff.lott
RTC Expired
Posts: 11
|
|
« on: December 03, 2015, 05:49:30 PM » |
|
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.
|