/packages/fcl-net/examples/rpcserv.pp
Puppet | 73 lines | 60 code | 13 blank | 0 comment | 1 complexity | 1309faa79b9c62f2eb50bf302355dcd5 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1program RPCServ; 2 3uses SysUtils, Classes, fpAsync, HTTPSvlt, svrclass, svrclass_XMLRPC; 4 5type 6 7 TServerApplication = class(TComponent) 8 private 9 EventLoop: TEventLoop; 10 HttpServer: THttpServer; 11 ServerClass: TServerClass; 12 XMLRPCServlet: TServerClassXMLRPCServlet; 13 procedure OnKeyboardData(Sender: TObject); 14 public 15 constructor Create; 16 destructor Destroy; override; 17 procedure Run; 18 end; 19 20constructor TServerApplication.Create; 21begin 22 inherited Create(nil); 23 24 EventLoop := TEventLoop.Create; 25 26 ServerClass := TServerClass.Create; 27 28 XMLRPCServlet := TServerClassXMLRPCServlet.Create(Self); 29 XMLRPCServlet.Name := 'XMLRPCServlet'; 30 XMLRPCServlet.ServerClass := ServerClass; 31 32 HttpServer := THttpServer.Create(Self); 33 HttpServer.EventLoop := EventLoop; 34 if ParamCount = 2 then 35 HttpServer.Port := StrToInt(ParamStr(1)) 36 else 37 HttpServer.Port := 12345; 38 HTTPServer.AddServlet(XMLRPCServlet, '/xmlrpc'); 39 40 WriteLn('Listening on port ', HttpServer.Port); 41end; 42 43destructor TServerApplication.Destroy; 44begin 45 HTTPServer.Free; 46 XMLRPCServlet.Free; 47 ServerClass.Free; 48 EventLoop.Free; 49 inherited Destroy; 50end; 51 52procedure TServerApplication.Run; 53begin 54 EventLoop.SetDataAvailableNotify(StdInputHandle, @OnKeyboardData, nil); 55 HttpServer.Active := True; 56 EventLoop.Run; 57end; 58 59procedure TServerApplication.OnKeyboardData(Sender: TObject); 60begin 61 EventLoop.Break; 62end; 63 64var 65 App: TServerApplication; 66begin 67 App := TServerApplication.Create; 68 try 69 App.Run; 70 finally 71 App.Free; 72 end; 73end.