/packages/fcl-net/examples/rpcserv.pp

 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.