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

https://github.com/slibre/freepascal · Puppet · 383 lines · 345 code · 38 blank · 0 comment · 2 complexity · 9fb8786c7ec2af02ab30031742556cf4 MD5 · raw file

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