wsserver.lpr 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118
  1. program wsserver;
  2. uses
  3. {$ifdef unix} cthreads, cwstring, {$endif}
  4. custapp, sysutils, jsonparser, fpjson, syncobjs, classes,
  5. fpwebsocket, fpwebsocketclient, fpwebsocketserver, fpcustwsserver, wschat;
  6. Type
  7. { TWSApp }
  8. TWSApp = class(TCustomApplication)
  9. private
  10. FSrv : TWebSocketServer;
  11. FChat : TWebsocketChat;
  12. procedure DoChatLog(Sender: TObject; const Msg: String);
  13. procedure Usage(const aError: string);
  14. Public
  15. constructor create(aOwner : TComponent); override;
  16. destructor destroy; override;
  17. procedure DoRun; override;
  18. end;
  19. { TWSApp }
  20. procedure TWSApp.DoChatLog(Sender: TObject; const Msg: String);
  21. begin
  22. Writeln(Msg);
  23. end;
  24. constructor TWSApp.create(aOwner: TComponent);
  25. begin
  26. inherited create(aOwner);
  27. FSrv:=TWebSocketServer.Create(Self);
  28. FChat:=TWebsocketChat.Create(Self);
  29. FChat.WebsocketServer:=FSrv;
  30. FChat.OnLog:=@DoChatLog;
  31. // Must do this here, because the events are protected
  32. FSrv.OnMessageReceived:[email protected];
  33. FSrv.OnControlReceived:[email protected];
  34. FSrv.OnDisconnect:[email protected];
  35. end;
  36. destructor TWSApp.destroy;
  37. begin
  38. FreeAndNil(FChat);
  39. FreeAndNil(FSrv);
  40. inherited destroy;
  41. end;
  42. procedure TWSApp.Usage(const aError : string);
  43. begin
  44. if aError<>'' then
  45. Writeln('Error: ',aError);
  46. Writeln('Usage ',ExtractFileName(Paramstr(0)), ' [options] ');
  47. Writeln('Where options is one or more of:');
  48. Writeln('-h --help This help text');
  49. Writeln('-p --port=PORT Set port to listen on');
  50. Writeln('-t --threadmode=MODE Set the threading mode');
  51. Writeln(' MODE is one of:');
  52. Writeln(' * threaded');
  53. Writeln(' * none');
  54. Writeln(' * pool');
  55. Writeln('-w --wait=TIME Set wait time in milliseconds');
  56. Writeln('-i --idle=TIME Set idle time in milliseconds');
  57. Writeln('-m --mask=MASK Set outgoing frame mask (a 16-bit integer)');
  58. ExitCode:=Ord(aError<>'');
  59. end;
  60. procedure TWSApp.DoRun;
  61. Var
  62. S : String;
  63. begin
  64. S:=CheckOptions('p:t:ahw:i:m:',['port:','threadmode','accept-threaded','help','wait:','idle:','mask:']);
  65. if (S<>'') or HasOption('h','help') then
  66. begin
  67. Terminate;
  68. Usage(S);
  69. exit;
  70. end;
  71. case GetOptionValue('t','threadmode') of
  72. 'pool' : FSrv.ThreadMode:=wtmThreadPool;
  73. 'thread' : FSrv.ThreadMode:=wtmThread;
  74. 'none' : FSrv.ThreadMode:=wtmNone;
  75. else
  76. FSrv.ThreadMode:=wtmThread;
  77. end;
  78. // Will not return till stopped.
  79. FSrv.ThreadedAccept:=HasOption('a','accept-threaded');
  80. if HasOption('w','wait') then
  81. FSrv.MessageWaitTime:=StrToIntDef(GetOptionValue('w','wait'),DefaultWaitTime);
  82. if HasOption('i','idle') then
  83. FSrv.AcceptIdleTimeout:=StrToIntDef(GetOptionValue('i','idle'),DefaultAcceptTimeout);
  84. FSrv.Port:=StrToIntDef(GetOptionValue('p','port'),6060);
  85. FSrv.Active:=True;
  86. FSrv.OutgoingFrameMask:=StrToIntDef(GetOptionValue('m','mask'),0);
  87. if Not FSrv.ThreadedAccept then
  88. Terminate
  89. else
  90. While Not Terminated do
  91. Sleep(10);
  92. end;
  93. begin
  94. With TWSApp.Create(Nil) do
  95. try
  96. Initialize;
  97. Run;
  98. finally
  99. Free;
  100. end;
  101. end.