/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.pp

  1unit wmdemo; 
  2
  3{$mode objfpc}{$H+}
  4
  5interface
  6
  7uses
  8  Classes, SysUtils, HTTPDefs, websession, fpHTTP, fpWeb; 
  9
 10type
 11
 12  { TFPWebModule1 }
 13
 14  TFPWebModule1 = class(TFPWebModule)
 15    procedure DataModuleCreate(Sender: TObject);
 16    procedure TFPWebActions0Request(Sender: TObject; ARequest: TRequest;
 17      AResponse: TResponse; var Handled: Boolean);
 18    procedure TFPWebActions1Request(Sender: TObject; ARequest: TRequest;
 19      AResponse: TResponse; var Handled: Boolean);
 20    procedure TFPWebActions2Request(Sender: TObject; ARequest: TRequest;
 21      AResponse: TResponse; var Handled: Boolean);
 22    procedure TFPWebActions3Request(Sender: TObject; ARequest: TRequest;
 23      AResponse: TResponse; var Handled: Boolean);
 24    procedure TFPWebActions4Request(Sender: TObject; ARequest: TRequest;
 25      AResponse: TResponse; var Handled: Boolean);
 26    procedure TFPWebActions5Request(Sender: TObject; ARequest: TRequest;
 27      AResponse: TResponse; var Handled: Boolean);
 28    procedure TFPWebActions6Request(Sender: TObject; ARequest: TRequest;
 29      AResponse: TResponse; var Handled: Boolean);
 30  private
 31    { private declarations }
 32  public
 33    { public declarations }
 34  end; 
 35
 36var
 37  FPWebModule1: TFPWebModule1; 
 38
 39implementation
 40
 41{$R *.lfm}
 42
 43Uses fpjson,jsonparser,fpjsonrpc,webjsonrpc, fpextdirect;
 44
 45{ TFPWebModule1 }
 46
 47procedure TFPWebModule1.DataModuleCreate(Sender: TObject);
 48begin
 49end;
 50
 51procedure TFPWebModule1.TFPWebActions0Request(Sender: TObject;
 52  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
 53{
 54  Demo 1. Manually do everything.
 55  Only a single method call is supported.
 56}
 57Var
 58  P : TJSONParser;
 59  Req,Res : TJSONData;
 60  Env,O : TJSONObject;
 61  M : TJSONStringType;
 62  E : TJSONRPCEcho;
 63  I : Integer;
 64  ID : TJSONData;
 65  Err : TJSONData;
 66
 67begin
 68  Res:=Nil;
 69  Err:=Nil;
 70  ID:=Nil;
 71  try
 72    P:=TJSONParser.Create(ARequest.Content);
 73    try
 74      Req:=P.Parse;
 75      try
 76        If Not (Req is TJSONObject) then
 77          JSONRPCError(SErrRequestMustBeObject);
 78        O:=(Req as TJSONObject);
 79        I:=O.IndexOfName('id');
 80        If (I=-1) then
 81          JSONRPCError(SErrNoIDProperty);
 82        ID:=O.Items[i].Clone;
 83        if O.IndexOfName('method')=-1 then
 84          JSONRPCError(SErrNoMethodName);
 85        M:=O.Strings['method'];
 86        If (m<>'echo') then
 87          JSONRPCError('Only echo method is supported');
 88        E:=TJSONRPCEcho.Create(Self);
 89        try
 90          I:=O.IndexOfName('params');
 91          Res:=E.Execute(O.Items[i],Nil);
 92        finally
 93          E.Free;
 94        end;
 95      finally
 96        Req.Free;
 97      end;
 98    finally
 99      P.Free;
100    end;
101  except
102    On E : Exception do
103      Err:=TJSONObject.Create(['message',E.Message,'name',E.ClassName,'code',-1]);
104  end;
105  If Assigned(ID) and (ID.JSONType<>jtNull) then
106    begin
107    Env:=TJSONObject.Create();
108    try
109      If not Assigned(Res) then
110        Res:=TJSONNull.Create;
111      Env.Add('result',Res);
112      If (Err=Nil) then
113        Err:=TJSONNull.Create;
114      Env.Add('error',Err);
115      Env.Add('id',ID);
116      AResponse.Content:=Env.AsJSON;
117    finally
118      Env.Free;
119    end;
120    end;
121  AResponse.SendContent;
122  Handled:=True;
123end;
124
125procedure TFPWebModule1.TFPWebActions1Request(Sender: TObject;
126  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
127
128{
129  Demo 2. Use a dispatcher to dispatch the requests.
130  The handler is located on the owner module
131  (it is created run-time, though)
132}
133
134Var
135  Echohandler:TJSONRPCEcho;
136  Disp : TJSONRPCDispatcher;
137  P : TJSONParser;
138  Req,res : TJSONData;
139  O : TJSONRPCDispatchOptions;
140
141begin
142  Echohandler:=TJSONRPCEcho.Create(Self);
143  try
144    EchoHandler.Name:='echo';
145    Disp:=TJSONRPCDispatcher.Create(Self);
146    try
147      O:=Disp.Options;
148      Include(O,jdoRequireClass);
149      Disp.Options:=O;
150      P:= TJSONParser.Create(ARequest.Content);
151      try
152        Req:=P.Parse;
153        try
154          Res:=Nil;
155          Res:=Disp.Execute(Req,Nil);
156          try
157            If Assigned(Res) then
158              begin
159              AResponse.Content:=Res.AsJSON;
160              end;
161            AResponse.SendContent;
162            Handled:=True;
163          finally
164            FreeAndNil(Res);
165          end;
166        finally
167          Req.Free;
168        end;
169      finally
170        P.Free;
171      end;
172    finally
173      Disp.Free;
174    end;
175  finally
176    EchoHandler.Free;
177  end;
178
179end;
180
181procedure TFPWebModule1.TFPWebActions2Request(Sender: TObject;
182  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
183{
184  Demo 3. Use a dispatcher to dispatch the requests,
185  The handler is registered in the JSONFPCHandlerManager.
186  (it is created run-time, though)
187}
188
189Var
190  Disp : TJSONRPCDispatcher;
191  P : TJSONParser;
192  Req,res : TJSONData;
193  O : TJSONRPCDispatchOptions;
194
195begin
196  JSONRpcHandlerManager.RegisterHandler('','echo',TJSONRPCEcho);
197  try
198    Disp:=TJSONRPCDispatcher.Create(Self);
199    try
200      O:=Disp.Options;
201      Include(O,jdoSearchRegistry);
202      Disp.Options:=O;
203      P:= TJSONParser.Create(ARequest.Content);
204      try
205        Req:=P.Parse;
206        try
207          Res:=Nil;
208          Res:=Disp.Execute(Req,Nil);
209          try
210            If Assigned(Res) then
211              begin
212              AResponse.Content:=Res.AsJSON;
213              end;
214            AResponse.SendContent;
215            Handled:=True;
216          finally
217            FreeAndNil(Res);
218          end;
219        finally
220          Req.Free;
221        end;
222      finally
223        P.Free;
224      end;
225    finally
226      Disp.Free;
227    end;
228  finally
229    JSONRpcHandlerManager.UnRegisterHandler('','echo');
230  end;
231end;
232
233procedure TFPWebModule1.TFPWebActions3Request(Sender: TObject;
234  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
235
236{
237  Demo 4. Ext.Direct dispatcher
238  The handler is registered in the JSONFPCHandlerManager.
239  (it is created run-time, though)
240}
241
242Var
243  Disp : TExtDirectDispatcher;
244  P : TJSONParser;
245  Req,res : TJSONData;
246  O : TJSONRPCDispatchOptions;
247
248begin
249  JSONRpcHandlerManager.RegisterHandler('test','echo',TJSONRPCEcho);
250  try
251    Disp:=TExtDirectDispatcher.Create(Self);
252    try
253      O:=Disp.Options;
254      Include(O,jdoSearchRegistry);
255      Disp.Options:=O;
256      P:= TJSONParser.Create(ARequest.Content);
257      try
258        Req:=P.Parse;
259        try
260          Res:=Nil;
261          Res:=Disp.Execute(Req,Nil);
262          try
263            If Assigned(Res) then
264              begin
265              AResponse.Content:=Res.AsJSON;
266              end;
267            AResponse.ContentLength:=Length(AResponse.Content);
268            AResponse.SendContent;
269            Handled:=True;
270          finally
271            FreeAndNil(Res);
272          end;
273        finally
274          Req.Free;
275        end;
276      finally
277        P.Free;
278      end;
279    finally
280      Disp.Free;
281    end;
282  finally
283    JSONRpcHandlerManager.UnRegisterHandler('','echo');
284  end;
285end;
286
287procedure TFPWebModule1.TFPWebActions4Request(Sender: TObject;
288  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
289
290{
291  Demo 5. Using a TJSONRPCContentProducer.
292  The handler is registered in the JSONFPCHandlerManager.
293  (it is created run-time, though)
294}
295
296Var
297  Cont : TJSONRPCContentProducer;
298  disp : TJSONRPCDispatcher;
299
300begin
301  JSONRpcHandlerManager.RegisterHandler('test','echo',TJSONRPCEcho);
302  try
303    Cont:=TJSONRPCContentProducer.Create(Self);
304    try
305      disp:=TJSONRPCDispatcher.Create(Cont);
306      Disp.Options:=Disp.OPtions+[jdoSearchRegistry];
307      Cont.Dispatcher:=Disp;
308      AResponse.ContentStream:=TMemoryStream.Create;
309      try
310        Cont.GetContent(ARequest,AResponse.ContentStream,Handled);
311        AResponse.ContentLength:=AResponse.ContentStream.Size;
312        If Handled then
313          AResponse.SendContent;
314      finally
315        AResponse.ContentStream.Free;
316      end;
317    finally
318      Cont.Free;
319    end;
320  finally
321    JSONRpcHandlerManager.UnRegisterHandler('','echo');
322  end;
323end;
324
325procedure TFPWebModule1.TFPWebActions5Request(Sender: TObject;
326  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
327{
328  Demo 6. creating an API response for Ext.Direct
329  The handler is registered in the JSONFPCHandlerManager.
330  (it is created run-time, though)
331}
332
333Var
334  D : TExtDirectDispatcher;
335  I : Integer;
336
337begin
338  JSONRpcHandlerManager.RegisterHandler('test','echo',TJSONRPCEcho);
339  try
340    D:=TExtDirectDispatcher.Create(Self);
341    try
342      D.URL:=BaseURL+'ExtDirect';
343      D.Options:=D.Options+[jdoSearchRegistry];
344      AResponse.Content:=D.APIAsString;
345      AResponse.ContentLength:=Length(AResponse.Content);
346    finally
347      D.Free;
348    end;
349  finally
350    JSONRpcHandlerManager.UnRegisterHandler('','echo');
351  end;
352end;
353
354procedure TFPWebModule1.TFPWebActions6Request(Sender: TObject;
355  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
356{
357  Demo 6. Using a TJSONRPCModule instance to handle the request.
358  The handler is registered in the JSONFPCHandlerManager.
359  (it is created run-time, though)
360}
361
362Var
363  M : TJSONRPCModule;
364
365begin
366  JSONRpcHandlerManager.RegisterHandler('test','echo',TJSONRPCEcho);
367  try
368    M:=TJSONRPCModule.CreateNew(Self,0);
369    try
370      M.HandleRequest(ARequest,AResponse);
371      Handled:=True;
372    finally
373      M.Free;
374    end;
375  finally
376    JSONRpcHandlerManager.UnRegisterHandler('','echo');
377  end;
378end;
379
380initialization
381  RegisterHTTPModule('echo', TFPWebModule1);
382end.
383